github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 19:21:02 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_10/fur/fur.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

3359 lines
103 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE FUR -- FILE UTILITY ROUTINE -- %2Q(75)
SUBTTL GLENN RICART, NATIONAL INSTITUTES OF HEALTH JULY 1974
CUSTVR==0 ; DEC DEVELOPMENT
DECVER==2 ; MAJOR VERSION
DECMVR==20 ; MINOR VERSION
DECEVR==75 ; EDIT NUMBER
; COPYRIGHT (C) 1974, 1975, 1976, 1977, 1978, 1979 GLENN RICART, NATIONAL INSTITUTES OF HEALTH
SEARCH MACTEN,UUOSYM,SCNMAC
SALL
; ASSEMBLY INSTRUCTIONS
IF1,< ..==%%MACT+%%SCNM
IFNDEFN ..,<
PRINTX ? .COMPILE MACTEN.UNV,UUOSYM.UNV,SCNMAC.UNV,FUR,SCAN,HELPER,WILD,ENDECR
PASS2
END>
PURGE ..>
XP %%FUR,CUSTVR*1B2+DECVER*1B11+DECMVR*1B17+DECEVR
HSGAD=640000 ; HISEG ORIGIN DESIRED
IFLE .CPU.-.CCKAX,<HSGAD=400000>
; KA-10 CANNOT DO RANDOM HISEG ORIGINS
TWOSEG HSGAD
LOC 137
EXP %%FUR
RELOC 0
MLON
SUBTTL PARAMETERS
IFNDEF FTDM,<FTDM==-1> ; USE DUMP-MODE COPYING
;;;;;IFNDEF FTFILOP,<FTFILOP==-1> ; USE FILOP
IFNDEF FTNIH,<FTNIH==0> ; RUNNING AT NIH
IFNDEF FTCUA,<FTCUA==0> ; RUNNING AT CUA
IFN FTNIH,<PRINTX MAKING FUR TO RUN AT NIH>
IFN FTCUA,<PRINTX MAKING FUR TO RUN AT CUA>
IFE FTNIH!FTCUA,<PRINTX MAKING FUR TO RUN AT RANDOM SITE>
IFN FTCUA,<
MAXCOR==<^D512*^D80> ; USE 80 PAGES OF CORE
PRVPRJ==10 ; PRIVILEGED PROJECT NUMBER
FT$MAI==1 ; CHECK FOR MAIL AREA PPN
>
IFN FTNIH,<
FT$MAI==1 ; CHECK FOR MAIL AREA PPN
>
ND MAXCOR,<^D512*^D500> ; [64] LIMIT MAX CORE SIZE TO 510 PAGES...YOU CAN CHANGE THIS
; TO RESTRICT THE AMOUNT OF CORE FUR WILL GOBBLE ON A COPY COMMAND
ND PRVPRJ,0 ; [64] PRIVED PROJECT OTHER THAN 1,2
ND FT$MAI,0 ; [72] DEFAULT NOT TO CHECK FOR THE MAIL PPN
ND FT$ISM,1 ; [73] DEFAULT TO ASSEMBLE WITH ISAM CODE
SUBTTL REVISION HISTORY
COMMENT 
[2] ADD RENAME COMMAND
[3] MAKE THE FOLLOWING FIXES:
DELETE FILENAME WILL DELETE FILENAME. AND NOT FILENAME.*
MAKE RENAME HANDLE ERSATZ DEVICES WHEN SPECIFIED
MAKE RENAME RENAME OUT OF SFD'S OK (SHOULD BE FIXED
IN .STOPB IN SCAN, BUT ....
[4] FIX COPYING OF DIRECTORIES BY CHECKING RB.DIR BIT AND
COPYING CUSTOMER AND DEC PARAMETERS
[5] FIX SOME PROBLEMS WITH COPY; DON'T COPY .RBUSD; RECOVER
SPACE DONATED TO INBUFS AND OUTBUFS.
[6] CLEAN UP SOME ERROR HANDLING PROBLEMS IN THE COPY ROUTINE
SO THAT THEY CAN RECOVER AND COPY THE NEXT FILE EVEN IF
THE CURRENT FILE HAS A PROBLEM.
[7] IMPLEMENT THE BEQUIET SWITCH TO CLOSE DOWN OUTPUT
[10] IMPROVE ERROR MESSAGES ON LOOKUP ERROR IN COPY/RENAME
[11] ADD ENCRYPTION FACILITIES
[12] FIX TERRIBLE BUG WHICH IN BEQUIET MODE CAUSED RENAMES TO FAIL
[13] MAKE COPY DO BLOCK TRANSFERS IF MODES AND BUFFER SIZES MATCH
ALSO USE 33 BUFFERS
[14] FIX BUG IN DIRECTORY CREATION IF NOT [1,2] DOING IT
[15] DON'T COUNT FILES IN THE FILE COUNT IF "NO" WAS GIVEN
TO A DECIDE
[16] ZERO LUKBL1 ON A COPY SO AS NOT TO PERPETUATE AN EXTENDED RIB
ADDRESS
[17] CHANGE UFDGDP TO USE A DIFFERENT PATH BLOCK SO AS NOT TO
CLOBBER THE BLOCK THAT LUKBLK HAS USED FOR A FILE LOOKUP.
THIS AFFECTS THE PRINTING OUTPUT. ALSO CHANGE DIRECTIONS
TO NOTE THAT ENDECR SHOULD BE LOADED FOR THE ENCRYPTION.
[20] IMPLEMENT MONITOR COMMANDS
[21] MAKE SWITCH.INI WORK PROPERLY FOR DECIDE OPTION
[22] ADD HELP ON QUESTION ASKER; DON'T ASK QUESTIONS WHEN BATCH
[23] FIX BUG INTRODUCED IN QUESTION ASKER WHERE LOWER CASE WOULD
NOT WORK
[24] INTRODUCE FILE CONCATENATION IF '+' IS GIVEN
[25] FIX MISTAKE IN THROUGHPUT CALCULATION IF WORD MODE IS USED
(NOT NORMALLY USED EXCEPT IN CASE OF CONCATENATION)
[26] SET SEARCH SYS AFTER NEW BIT IN CALL TO WILD
[27] DEFAULT FIND COMMAND TO SYS AFTER NEW AND ALL EXTENSIONS.
OTHER COMMANDS DEFAULT TO NO SYS AFTER NEW AND NO EXTENSION.
ALSO, SYS IS CHANGED TO STD: TO UNCONFUSE PEOPLE.
[30] FIX UP UFDGDP TO ZERO OUT THE WORDS THAT A 6.02 OR 6.02A
MONITOR WILL RETURN IF YOU CURRENT PATH IS AN SFD AND YOU
ASK FOR THE PATH OF A DEVICE WITH AN IMPLIED PPN.
[31] FIX BUG WHERE CONCATENTATE GOT ILLEGAL MODE FOR DEVICE
*** VERSION H ***
[32] ADD NEW COMMANDS BACKUP AND NOBACKUP TO SET AND RESET BIT
THAT PREVENTS BACKUP/FAILSAFE FROM SAVING FILE.
*** VERSION 2 ***
[33] IMPLEMENT 'AND', 'OR', AND 'NOT' THANKS TO MARANTZ@RUTGERS-10.
*** VERSION 2A ***
[34] ERASE COMMAND
** VERSION 2B ***
[35] FIX BUG WHERE ENCRYPTED FILES WOULD BE BLTED AGAINST THEIR WILL
[36] TELL STOPB THAT LOOKUP BLOCK IS LONG ENOUGH FOR VERSION INDICATION
[37] USE STOPB INSTEAD OF WILD IF INPUT NAME HAS NO WILDCARDS;
THIS ELIMINATES PROBLEM WITH WILD'S %NO SUCH DIRECTORY
[40] MAKE DECIDE A PER-FILE SWITCH
[41] LOAD WITH SPECIALLY GOOBERED VERSION OF SCAN SO AS TO
NOT PRINT DSK: WHEN IT IS THE DEVICE AND [P,PN] WHEN
IT IS THE LOGGED-IN PPN WHEN .TOLEB IS CALLED.
[42] USE BUFFERED TTY OUTPUT INSTEAD OF OUTCHR
[43] RUN DIRECTLY FROM MONITOR LEVEL COMMANDS
[44] MAKE CONCATENATE, BEQUIET, AND DECIDE FILE-LEVEL SWITCHES
[45] FIX MINOR PROBLEMS THAT SHOWED UP IN EDITS 41-44
ALSO, TURN OFF RP.LOG, RP.NDL, AND RP.ABC WHEN COPYING
FILES TO AVOID PROBLEM WITH COPYING CRASH.EXE INTO
AN UNDELETABLE FILE.
ALSO PRESERVE VERSION NUMBERS ON RENAME
[46] (A) ADD CRLF AFTER FURCCF MESSAGE
(B) MOVE ALL STATISTICS INTO COMMON ROUTINE
(C) CHANGE THE WAY THAT DELETE AND ERASE ASKS FOR FILE NAMES
[47] FIX BUG IN COPY WHERE HEADER GOT CLOBBERED BY WILD
[50] HAVE DELETE/ERASE ASK FOR PERMISSION IF PROTECTED
PROTECTION CODES ALWAYS HAVE 3 DIGITS
[51] CHANGE DEVICE NAME TO 'SYS' IF USER ASKS MONITOR FOR
OLD BUT MONITOR GIVES HIM SYS. EVEN THOUGH IT'S WRONG,
USER CAN SEE IT IS WRONG, AND THIS IS HOW MONITOR OPERATES.
SIMILARLY, ASK FOR NEW:FOO.MAC AND IT MIGHT REPLY WITH SYS:FOO.MAC.
[52] ZERO OUT SIZE AND ALLOCATED WORDS BEFORE LOOKUP SO YOU
CAN DELETE ZERO SIZE FILES ON NUL:
[53] OSCAN DEFAULTS WHICH WERE FUR-ONLY SWITCHES (SUCH AS
DECIDE, WERE NOT BEING KEPT AROUND WELL ENOUGH. FIX THINGS
SO THAT OSCAN DEFAULTS ARE MEMORIZED. ALSO, MEMORIZATION WILL TAKE
PLACE ON "STICKY" SWITCHES SPECIFIED BEFORE FILE SPECS THROUGH
NEW ROUTINE STQMEM BUT THEY WILL BE FORGETTEN AT THE
EQUAL SIGN OR END OF LINE.
[54] MAKE CREATION DATE/TIME, VERSION, ETC. OF OUTPUT FILES BE
ZERO IF /NEWFILE IS USED TO MAKE HERMAN HAPPY.
[55] GIVE BACK TAKEN CORE ON CONCATENATE COMMANDS.
GIVE BACK CORE AT THE END OF EACH COMMAND THROUGH STATFI.
RE-USE SAME INPUT BUFFER RING ON CONCATENATE COMMANDS.
ADD /SPLNAM:XXXX SWITCH. ON THE INPUT SIDE, ONLY FILES
WHOSE SPOOL-ED NAME MATCH XXXX WILL BE SELECTED. ON TH
OUTPUT SIDE, THE SPOOLED NAME XXXX WILL BE GIVEN TO THE FILE.
TO SELECT OR ASSIGN A BLANK NAME, USE /SPLNAM:. TO GO
BACK TO THE USUAL MODE (DON'T FILTER ON INPUT, AND COPY
OUTPUT SPOOL NAMES FROM INPUT SPOOL NAMES), USE /SPLNAM.
** VERSION 2I **
[56] DON'T TURN OFF RP.ABC ON SFDS AND UFDS
** VERSION 2J **
[57] FIX GCWILD TO CALL WILD WHEN IT SEES /STRS
[60] PROMPT USER FOR CONCATENATE WHEN OUTPUT SPEC NOT WILD
[61] FIX PROBLEM IN ACCIDENTAL DELETION CHECK ROUTINE
** VERSION 2K **
[62] Preserve file extension and date (.rbext) when doing
DELETE in case of failure. To prevent date becoming
messed up when overiding protection during rename and
trying to delete again. If second delete fails it leaves
the date for the file confused. D. Baldwin, CUA
[63] Add PAD function to FUR. Used primarily to protect
ISAM index and data files from system crashes. It
add (pads) null block onto the end of a specified file
thereby cutting down number of times isam must ask for
more room on disk. D. Baldwin, CUA
[64] Add MAXCORE capability to FUR. Limits growth of I/O buffers
normally to 80P(ages). Allows user to decrease this limit
or if user is priv ([1,2] and one selected project PRVPRJ)
he may increase the buffer maximum D. Baldwin, CUA
** VERSION 2L WITH ED MULREAN, CUA **
[65] Add extra text to file already exists error to inform
people that the /ERSUPERSEDE might be doing them in.
[66] Add error check for write-locked tape in the erase command.
[67] Keep statistics by blocks as well as words to allay fears
of HWV on FUR copying.
[70] Fix bug in edit [67] when statistics are on word-by-word
copying such as is forced by /concatenate
[71] Make DELETE * not acceptable (users type DELETE *,TMP instead
of DELETE *.TMP). Now you must say *.*. Also, a DELETE or
ERASE command cannot take null filespec. (You must say *.*)
[72] Add capability to print files in the Mail area as ppn's instead
of funny sixbit characters. D. Baldwin CUA
[73] Add the AUTHOR, STATUS,
and add the DUMP command for dumping Isam statistics
blocks.
C. D. Baldwin CUA
[74] Incorporate fix from John edgecombe, Stn. 79, Maths & Comp,
Chalk River Nuclear Labs, Atomic Energy of Canada Ltd,
Chalk River, Ontario Canada K0J1J0 (613) 687-5581
for KA-sites in determining location of high segment
[75] Make ERASE MTA1: work again. A prior edit made specification
of *.* necessary in this case. Now checks to see if a
directory device.

SUBTTL DEFINITIONS
; ACCUMULATOR REFERENCES
F=0 ; FLAGS
T1=1 ; TEMPORARY
T2=2
T3=3
T4=4
P1=5 ; PRESERVED
P2=6
N=7 ; WORD SCANNING RESULT
C=10 ; CURRENT BREAK CHARACTER
;=11
;=12
;=13
;=14
;=15
;=16
P=17 ; STACK POINTER
; NOTE THAT THESE ACCUMULATOR DEFINITIONS MUST MESH WITH
; SCAN AND WILD.
$FXLEN==.FXLEN+7 ; EXTRA WORDS FOR KEY AND DECIDE
KEYOFF==.FXLEN ; OFFSET FOR KEY
FURBTO==.FXLEN+1 ; OFFSET FOR FUR-SPECIFIC BITS
FURBTM==.FXLEN+2 ; MASK
FURSTA==.FXLEN+3 ; STATUS SWITCH VALUE TO MATCH OR SET
FURSPL==.FXLEN+4 ; SPOOL FILE NAME
FURAUR==.FXLEN+5 ; AUTHOR SWITCH
FURAUM==.FXLEN+6 ; AUTHOR MASK
TTYCHAN==4 ; USE CHANNEL 4 FOR TTY
DEFINE MOV2(REG,LOC),<
IFGE .CPU.-.CCKIX,< DMOVE REG,LOC>
IFE .CPU.-.CCKAX,< MOVE REG,LOC
<MOVE REG+1,LOC>+1>
>
DEFINE MOV2M(REG,LOC),<
IFGE .CPU.-.CCKIX,< DMOVEM REG,LOC>
IFE .CPU.-.CCKAX,< MOVEM REG,LOC
<MOVEM REG+1,LOC>+1>
>
IFN FT$ISM,< ; [73] Add DUMP command to dump ISAM stat blocks
DEFINE ISAMDUMP,< ; Define big macro to build table for dump command
X ^D0,.TXWDW##,<(LH) Index block ID,(RH) Size of Index block in bytes.>
X ^D1,$TSIXN,<Isam Data file device.>
X ^D2,$TSIXN,<Isam Data file name.>
X ^D3,$TSIXN,<Isam Data file extension.>
X ^D4,.TDATE##,<Isam Data file create date>
X ^D5,.TDATE##,<Isam Data file access date.>
X ^D6,$TDECW,<Levels of Indexes.>
X ^D7,$TDECW,<Isam Data file blocking factor.>
X ^D8,$TDECW,<Empty records per Data block.>
X ^D9,$TDECW,<Isam Index file blocking factor.>
X ^D19,$TDECW,<Empty entries per Index block.>
X ^D29,$TDECW,<Number of Data blocks in file.>
X ^D30,$TDECW,<Number of empty Data blocks in file.>
X ^D31,$TDECW,<Number disk blocks in Index file.>
X ^D32,$TDECW,<Number of empty disk blocks in Index file.>
X ^D33,$TDECW,<First empty disk block in Index file.>
X ^D34,$TDECW,<Record length in words.>
X ^D35,.TXWDW##,<Byte pointer to the record key.>
X ^D36,$TDECW,<Number of LIBOL Reads/Rewrites/Deletes/Writes.>
X ^D37,$TDECW,<Number of In/Out UUOs executed by LIBOL.>
X ^D38,$TDECW,<Logical address of first SAT block.>
X ^D39,$TDECW,<Number of SAT blocks in Index file.>
X ^D40,$TDECW,<Number of disk blocks in logical Index block.>
X ^D41,$TDECW,<Number of bits in all SAT blocks.>
X ^D42,.TKEYN,<Isam record key descriptor.>
X ^D42,.TMODW,<Recording mode of Data file.>
X ^D43,$TDECW,<Size of each Index entry.>
X ^D44,$TDECW,<Address of highest level Index entry.>
X ^D45,$TDECW,<Percentage of Data file to leave empty.>
X ^D46,$TDECW,<Percentage of Index file to leave empty.>
X ^D47,$TDECW,<Size of largest Data record in bytes.>
X ^D48,$TDECW,<Maximum number of records file can become.>
X ^D49,.TVERW##,<Isam version number.>
> ;end of ISAMDUMP macro
> ;end of IFN FT$ISM
SUBTTL LOWSEG STORAGE
BLOCK 1 ; LEAVE THE FIRST WORD FREE FOR
; SUPERSTITIOUS REASONS
OFFSET: BLOCK 1 ; CONTAINS STARTING OFFSET (0 OR 1)
INICOR: BLOCK 1 ; .JBFF,,.JBREL
SAVDEV: BLOCK 1 ; DEVICE FROM WHICH RUN
SAVNAM: BLOCK 1 ; FILE NAME
SAVLOW: BLOCK 1 ; LOW EXTENSION
SAVPPN: BLOCK 1 ; PPN
IFN FT$ISM,<
ISMBPT: POINT 7,DUMTMP ; [73] Byte pointer for temp storage area in dump command
> ;END OF IFN FT$ISM
IFN FT$MAI,< ;[72] ADD TEST FOR MAIL PPN
IFN FTCUA,<
MAIPPN: XWD 3,4 ;[72] MAIL PPN HERE AT CUA
>
IFN FTNIH,<
MAIPPN: XWD 1,7 ;[72] 1,7 AT NIH
>
IFE FTCUA!FTNIH,<
IFNDEF MAIPPN,<PRINTX ? FT$MAI TURNED ON BUT MAIPPN NOT DEFINED>
>
>
LN$PDL==100 ; PUSH DOWN LIST LENGTH
PDLIST: BLOCK LN$PDL+1
LOWS:! ; LOW AREA START
DEFINE S$FILE($LOC,$MNEM),<
;; THIS DEFINITION IS USED FOR DECLARING AREAS FOR FILE
;; PARAMETERS. $LOC IS 0 IF NOT SPECIFIED, 1 IF VERB
;; SPECIFIED BY NO FILE SPEC GIVEN, AND OTHER NON-ZERO
;; IF FILE SPEC IS GIVEN
$LOC:: BLOCK $FXLEN ;; FILE STORAGE SPEC WITH MAX LENGTH
MX.'$MNEM==$FXLEN
PD.'$MNEM==1 ;; NO DEFAULT
>
S.DEST: BLOCK $FXLEN ; SCAN STORAGE FOR DESTINATION
U.DEST: BLOCK $FXLEN ; STORAGE AS FIXED UP BY UPD DEFAULTER
OPNBLK: BLOCK 3 ; OPEN BLOCK
RIBSIZ==.RBAC8+1 ; LENGTH OF EXTENDED RIB FOR 6.03A
; WITH ACCOUNT STRINGS
LUKBLK: BLOCK RIBSIZ ; LOOKUP, ENTER, OR RENAME BLOCK
OPNBL1: BLOCK 3 ; OUTPUT OPEN BLOCK
LUKBL1: BLOCK RIBSIZ ; OUTPUT ENTER BLOCK OR RENAME
PTHBLK: BLOCK .PTMAX ; MAX LENGTH OF PATH
PTHBL1: BLOCK .PTMAX ; MAX LENGTH OF PATH
PTHGDP: BLOCK .PTMAX ; MAX LENGTH OF PATH; USED BY UFDGDP
BUFHD1: BLOCK 3
BUFHDR: BLOCK 3 ; BUFFER HEADERS
WLDBLK: BLOCK 4 ; WILD BLOCK
WLDFST: BLOCK 1 ; ADDRESS OF FIRST FILE SPEC
WLDLST: BLOCK 1 ; ADDRESS OF LAST FILE SPEC
WLDPTR: BLOCK 1 ; WILD'S POINTER INTO THE FILE SPECS.
$DECID: BLOCK 1 ; 1 IF /DECIDE, 0 IF NOT, -1 IF NOT INITIALIZED
$QUIET: BLOCK 1 ; 1 IF /BEQUIET, 0 IF NOT, -1 IF NOT INITIALIZED
$BATCH: BLOCK 1 ; 1 IF BATCH JOB, 0 IF NOT, -1 IF NOT INITIALIZED
SAVJFF: BLOCK 1 ; COPY OF JOBFF
SAVACB: BLOCK 10 ; PLACE TO SAVE ACS WHEN CALLING ENCRYPT
INRECN: BLOCK 1 ; READING IN RECORD NUMBER
OURECN: BLOCK 1 ; WRITING BLOCK NUMBER
CRYPTK: BLOCK 1 ; CRYPT KEY FROM SWITCH
FRFBTF: BLOCK 1 ; WORD OF FUR-SPECIFIC FILE BITS
FR.DEC==1B1 ; DECIDE
FR.BEQ==1B2 ; BEQUIET
FR.CTF==1B3 ; CONCATENATE
FR.ADC==1B4 ; ALLDECIDE
FR.ABQ==1B5 ; ALLBEQUIET
FR.MOV==FR.CTF!FR.ADC!FR.ABQ ; BITS TO BE MOVED TO FILESPECS TO THEIR LEFT
FR.OVR==1B6!1B7 ; OVERRIDE CODE FOR DELETE
;; 0, 1 = ASK UNDER TIMSHARING; OVERRIDE: ASK
;; 2 = DON'T ASK, AND DON'T DELETE; OVERRIDE:NO
;; 3 = DON'T ASK, BUT ALWAYS DELETE; OVERRIDE:YES
FR.NFP==1B8 ; /NEWFILE (DON'T COPY OLD PARAMETERS)
FR.STA==1B9!1B10 ; TYPE OF HANDLING FOR THE STATUS SWITCH
; IF 0 THEN STATUS IS ABSOLUTE SET ON OUTPUT
; EXACT MATCH ON INPUT
; IF 1 THEN STATUS IS A MASK MASKED BITS MUST BE ON FOR INPUT
; MASKED BITS ARE SET ON OUTPUT (OTHERS NOT CHANGED)
; IF 2 THEN STATUS IS A MASK MASKED BITS MUST BE OFF FOR INPUT
; MASKED BITS TURNED OFF ON OUTPUT(OTHERS NOT CHANGED)
FRFBTM: BLOCK 1 ; MASK FOR THEM
STAUSF: BLOCK 1 ; PLACE TO SAVE STATUS VALUE -1 IF NOT SET
SPLNMF: BLOCK 1 ; FILE SPOOLED NAME; -1 MEANS NOT SET
AUTHRF: BLOCK 1 ; FILE AUTHOR SWITCH
AUTHRM: BLOCK 1 ; MASK FOR AUTHOR SWITH
PERKEY: BLOCK 1 ; STICKY VERSION OF KEY
FRPBTF: BLOCK 1 ; STICKY VERSIONS
FRPBTM: BLOCK 1
STAUSP: BLOCK 1 ; STICKY VERSION OF STATUS VALUE
SPLNMP: BLOCK 1 ; FILE SPOOLED NAME PERMANENT VERSION
AUTHRP: BLOCK 1 ; STICKY VERSION OF AUTHOR SWITCH
AUTHMP: BLOCK 1 ; MASK
INRKEY: BLOCK 1 ; KEY FOR INPUT FILE
OURKEY: BLOCK 1 ; KEY FOR OUTPUT FILE
FRQBTF: BLOCK 1 ; COPY OF FRPBTF BUT UPDATED FOR STICK SWITCHES FOUND ON THE CURRENT LINE
FRQBTM: BLOCK 1 ; MASK FOR SAME
STAUSQ: BLOCK 1 ; SEMI-STICKY VERSION
SPLNMQ: BLOCK 1 ; SPOOLED NAME SEMI-STICKY
AUTHRQ: BLOCK 1 ; SEMI-STICKY VERSION
AUTHMQ: BLOCK 1 ; ETC..
NUMWDS: BLOCK 2 ; NUMBER OF WORDS PROCESSED
NUMBLK: BLOCK 1 ; NUMBER OF BLOCKS PROCESSED
TSTART: BLOCK 1 ; TIME THAT WE STARTED TRANSFERING FILES
NUMFIL: BLOCK 1 ; NUMBER OF FILES TRANSFERRED
TENDIT: BLOCK 1 ; TIME THAT WE ENDED TRANSFER
CONCTF: BLOCK 1 ; FLAG THAT, IF +1, FILES SHOULD BE CONCATENATED
; IF -1, UNINITIALIZED. IF 0, DON'T CONCATENATE
; IF -2, IN THE PROCESS OF CONCATENATION FOR THE
; FIRST FILE IN THE LIST
DOFIND: BLOCK 1 ; -1 IF DOING FIND, OTHERWISE 0
DODELE: BLOCK 1 ; -1 IF DOING DELETE OR ERASE, OTHERWISE 0
IFN FT$ISM,< ; [73] Add isam dump command
DODUMP: BLOCK 1 ; [73] -1 if doing dump otherwise 0
> ;end of IFN FT$ISM
CANSTD: BLOCK 1 ; -1 IF CAN USE DEVICE STD:, OTHERWISE 0
BAKSWT: BLOCK 1 ; -1 IF SET NO BACKUP; 0 IF NORMAL (ALLOW BACKUP)
; SWITCH APPLIES TO ALLOWING BACKUP TO BACK UP FILE
DMAADD: BLOCK 1 ; START OF DUMP MODE AREA
CPPL: BLOCK 1 ; HIGHEST LEGAL ADDRESS IN THE LOWSEG (+1) THAT IS STILL PHYSICAL AND FITS BELOW THE HISEG
TMPMOD: BLOCK 1 ; TEMPORARILY SAVE OPEN MODE (-1 MEANS DON'T OPEN)
GCWFST: BLOCK 1 ; SAVED WILD FIRST BLOCK ADDRESS
GCWLST: BLOCK 1 ; SAVED WILD LAST BLOCK ADDRESS
GCWPTR: BLOCK 1 ; GCWILD'S POINTER
GCWCAW: BLOCK 1 ; -1 IF GCWILD SHOULD CALL WILD AGAIN
ORGDIR: BLOCK 1 ; ORIGINAL DIRECTORY FOR FILE (SEE DOOLK)
TTYBFH: BLOCK 3 ; BUFFER HEADER FOR TTY
HPOS: BLOCK 1 ; HORIZONTAL POSITION
MONCMD: BLOCK 1 ; INDEX OF MONITOR - LEVEL COMMAND
PRTSUM: BLOCK 1 ; 0 IF NO SUMMARY PRINTED YET
CKACBK: BLOCK 3 ; CHKACC ARGUMENT BLOCK
PADFLG: BLOCK 1 ; [63] SWITCH CONTAINS TYPE OF PROCESSING TO BE DONE
; [63] WITH VALUE RETURNED (0) ABSOLUTE, (1) ADDITION (2 ) MULTIPLY
PADSIZ: BLOCK 1 ; [63] SIZE IN WORDS TO ADD TO FILE IN PAD FUNCTION
PADOSZ: BLOCK 1 ; [63]OLD FILE SIZE IS KEPT IN HERE
PADNSZ: BLOCK 1 ; [63]NEW FILE SIZE IS KEPT IN HERE
S.MXCR: BLOCK 1 ; [64] MAXCORE VALUE FROM SWITCH
SAVEXT: BLOCK 1 ; [62] Area to preserve Extension word of
; [62] file when doing rename if delete fails
; [62] because of protection failure
IFN FT$ISM,< ; [73] Add some things for the Isam dump routine
DUMBPT: BLOCK 1 ; [73] And place to keep it while we are working
BYTCNT: BLOCK 1 ; [73] Store our character count in here
DUMTMP: BLOCK 3 ; [73] The temporary buffer area used for DUMP
DUMCMD: BLOCK 1 ; [73] IO command list
> ;end of ifn ft$ism
LOWE:! ; LOW AREA END
LOWL=LOWE-LOWS ; LOW AREA LENGTH
SUBTTL INITIALIZATION
RELOC HSGAD ; GO TO HISEG
START: TDZA T1,T1 ; NORMAL ENTRY
MOVEI T1,1 ; T1 NOW CONTAINS STARTING OFFSET
MOVEM T1,OFFSET ; STORE FOR SCAN
RESET ; CLEAR OUT ALL DEVICES
SKIPE SAVDEV ; SEE IF WE KNOW WHERE WE WERE RUN FROM
JRST START1 ; YES, WE KNOW ALREADY.
MOVEM .SGDEV,SAVDEV ; NO. SAVE OUR CURRENT DEVICE
MOVEM .SGNAM,SAVNAM ; GET FILE NAME
MOVEM .SGLOW,SAVLOW ; SAVE LOW EXTENSION
MOVEM .SGPPN,SAVPPN ; GET PPN. NOTE THAT THE PATH
; FROM WHICH THE PROGRAM IS RUN
; IS NOT SAVED. (MONITOR PROBLEM)
START1:
STORE 17,0,16,0 ; CLEAR ACS
STORE 17,LOWS,LOWE-1,0; CLEAR LOW AREA
MOVE P,[IOWD LN$PDL,PDLIST] ; SET UP PUSH DOWN LIST
PUSHJ P,TTYOPN ; OPEN TTY FOR OUTPUT
HRRZ T1,.JBREL## ; GET FIRST-TIME CORE SIZE
HRL T1,.JBFF## ; AND FIRST FREE
MOVEM T1,INICOR ; SAVE INITIAL CORE
MOVE T1,[3,,[IOWD 5,['COPY '
'RENAME'
'ERASE '
'DELETE'
'PAD ']
OFFSET,,'FUR'
OUTONE]]
PUSHJ P,.ISCAN## ; START UP SCANNER
MOVEM T1,MONCMD ; SAVE MONITOR COMMAND
; SET UP STANDARD DEFAULTS
; SEE IF STD: AVAILABLE
MOVSI T1,(SIXBIT /STD/) ; SEE IF STD EXISTS
DEVCHR T1,
MOVEM T1,CANSTD ; STORE RESULTS IN CANSTD
SETOM CRYPTK ; MAKE CRYPT KEY -1
SETZM FRFBTM ; CLEAR MASK OF BITS
SETOM SPLNMP
SETOM SPLNMF ; CLEAR OUT SPOOLED FILE NAME
SETOM STAUSF ; CLEAR OUT STATUS VALUE
SETOM STAUSP
SETOM AUTHRF ; CLEAR OUT OUR AUTHOR SWITCH
SETOM AUTHRP
SETZM AUTHRM ; AND MASK
SETZM AUTHMP
; SETOM $QUIET
; SETOM CONCTF
SETOM $BATCH ; DON'T KNOW YET IF WE'RE BATCH
MOVE T1,[4,,SCNBLK] ; SET UP .OSCAN POINTER
PUSHJ P,.OSCAN## ; SCAN SWITCH.INI IF SET
SKIPGE T1,MONCMD
JRST CMDLOP ; ORDINARY COMMAND STYLE
MOVEI C,40 ; START-UP C REGISTER
REPEAT 0,< ; [63] Implement pad function as monitor command
PUSHJ P,@[EXP $COP,$REN,$ERS,$DEL](T1)
> ; [63] End of code removed for PAD function
PUSHJ P,@[EXP $COP,$REN,$ERS,$DEL,$PAD](T1)
JFCL
JRST CMDLO1 ; DONE WITH IT
CMDLOP: MOVE T1,[6,,SCNBLK] ; SET UP .VSCAN POINTER
PUSHJ P,.VSCAN## ; CHECK IT OUT
CMDLO1: PUSHJ P,RESCOR ; PUT CORE BACK FOR NEXT ONE
PUSHJ P,.MONRT## ; RETURN TO MONITOR OR GO AGAIN
JRST CMDLOP ; KEEP GOING
SCNBLK: IOWD VERBL,VERBN
XWD VERBD,VERBM
XWD 0,VERBP
EXP -1
XWD 7,CRYPTK ; ENCRYPTION KEY
XWD 0,PERKEY ; PERMANENT KEY
SUBTTL SWITCHES AND VERBS
DM MXC,1000000,MAXCOR,MAXCOR ;; [64] Add maxcore function to FUR
DEFINE SWTCHS,<
SP DIRECT,,$FIND,,FS.VRQ
SP FIND,,$FIND,,FS.VRQ
SP DELETE,,$DEL,,FS.VRQ
SP DDT,,$DDT,,
SP QUIT,,$QUIT,,
SP EXIT,,$QUIT,,
SN DECIDE,<POINTR (FRFBTF,FR.DEC)>
SN ALLDECIDE,<POINTR (FRFBTF,FR.ADC)>
SN BEQUIET,<POINTR (FRFBTF,FR.BEQ)>
SN ALLBEQUIET,<POINTR (FRFBTF,FR.ABQ)>
SN CONCAT,<POINTR (FRFBTF,FR.CTF)>
SN NEWFILE,<POINTR (FRFBTF,FR.NFP)>
SP RENAME,,$REN,,FS.VRQ
SP COPY,,$COP,,FS.VRQ
;;SP ENCRYPT,<POINT <^D65-^D10>,CRYPTV>,.ASCQW##,ENC
SP ENCRYPT,CRYPTK,GETKEY,ENC
SP PAD,,$PAD,,FS.VRQ ;; [63] Add pad function to FUR
SP MAXCOR,S.MXCR,GETMAX,MXC,FS.NFS!FS.LRG!FS.VRQ ;; [64] Add maxcore switch to FUR
SP CRYPT,CRYPTK,GETKEY,ENC
SP BACKUP,,$YBAK
SP NOBAKUP,,$NBAK
SP ERASE,,$ERS,,FS.VRQ
SL OVERRIDE,<POINTR (FRFBTF,FR.OVR)>,OVRK,OVRKYE
SP STATUS,STAUSF,GETSTA,,FS.LRG!FS.VRQ ;;[73] ADD STATUS SWITCH
SP SPLNAM,SPLNMF,.SIXSW##,SPL,FS.LRG
SP AUTHOR,AUTHRF,GETAUR,,FS.LRG!FS.VRQ ; AUTHOR SWITCH
IFN FT$ISM,< ; [73] Add ISAMDUMP command to dump ISAM stat blocks
SP ISAMDU,,$DUMP,,FS.NFS!FS.VRQ
> ;END OF IFN FT$ISM
>
MX.SPL==1
PD.SPL==-1
DOSCAN (VERB)
MX.ENC==1 ; DUMMY
PD.ENC==0 ; DUMMY
KEYS (OVRK,<ASK,NO,YES>)
IFN FT$ISM,< ; [73] Add dispatch tables for dump command
DEFINE X(A,B,C),<
EXP A
>
ISMT1: ISAMDUMP
ISMSIZ==.-ISMT1 ; [73] Define the length of our tables
DEFINE X(A,B,C),<
XWD 0,B
>
ISMT2: ISAMDUMP
DEFINE X(A,B,C),<
XWD 0,[ASCIZ \ ;'C'\]
>
ISMT3: ISAMDUMP
> ;END OF IFN FT$ISM
SUBTTL DELETE
$DEL: ; DELETE VERB
PUSHJ P,INIFLG ;[71]
SETOM DODELE
PUSHJ P,STATIN ; INITIALIZE STATISTICS
PUSHJ P,SCNFIL ; GET FILE NAMES
SETZM DODELE
DELOP: SETZM TMPMOD ; USE MODE 0
PUSHJ P,GCWILD ; CALL WILD OR STOPB AS APPROPRIATE
JRST DELTOT ; EXIT WHEN DONE
PUSHJ P,PRTPOP
JRST DELGO
PUSHJ P,PRFNMB ; PRINT NAME AND SIZE IN BLOCKS
PUSHJ P,YESNO
JRST DELTOT
JRST DELOP
DELGO: PUSH P,LUKBLK+.RBNAM
MOVE T1,LUKBLK+.RBEXT ; [62] Save extension word in case delete fails
MOVEM T1,SAVEXT ; [62]
SETZM LUKBLK+.RBNAM
RENAME LUKBLK
JRST DELFAI
POP P,LUKBLK+.RBNAM
DELADD: MOVE T1,LUKBLK+.RBALC
LSH T1,^D7
PUSHJ P,ADDWDS
PUSHJ P,ADDFIL ; ADD ONE TO FILE COUNT
JRST DELOP
DELTOT: PUSHJ P,STATOU ; OUTPUT STATISTICS
MOVEI T1,[ASCIZ . Deleted.]
SKIPE PRTSUM
PUSHJ P,.TSTRG##
PUSHJ P,STATFI ; OUTPUT RIGHT BRACKET AND CRLF
JRST .POPJ1##
DELFAI: ; RENAME HAS FAILED
POP P,LUKBLK+.RBNAM ; GET NAME BACK
LDB T1,[POINT 15,LUKBLK+.RBEXT,35] ; GET ERROR CODE
CAIE T1,ERPRT% ; PROTECTION FAILURE?
JRST DELFA1 ; NOPE, SOMETHING ELSE
MOVE T1,WLDPTR
LDB T1,[POINTR (FURBTO(T1),FR.OVR)] ; GET OVERRIDE CODE
CAIN T1,2 ; IF OVERRIDE:NO, DON'T TRY
JRST DELFA1
PUSHJ P,CHKBAT ; SEE IF RUNNING UNDER BATCH
CAIA ; NO, GO AHEAD
JUMPE T1,DELFA1 ; DON'T TRY ASKING IF WE ARE
LDB T1,[POINTR (LUKBLK+.RBPRV,RB.PRV)] ; GET PRIVS
HRLI T1,.ACCPR ; CHANGE PROTECTION CODE
MOVEM T1,CKACBK ; STORE IN CHKACC BLOCK
MOVE T1,ORGDIR
TLNN T1,-1 ; DIRECTORY THERE?
MOVE T1,.PTPPN(T1) ; TRY IN PATH
MOVEM T1,CKACBK+1 ; STORE FILE'S PPN
MOVE T1,.MYPPN## ; GET OUR PPN
MOVEM T1,CKACBK+2 ; STORE THAT TOO
MOVEI T1,CKACBK ; TRY CHKACC
CHKACC T1, ; CAN WE CHANGE PROTECTION?
SETZ T1, ; ASSUME WE CAN
JUMPL T1,DELFA1 ; NO, DON'T THINK WE CAN
; IF HERE, WE MIGHT POSSIBLY BE ABLE TO CHANGE PROTECTION
; AND DELETE IT.
MOVE T1,WLDPTR
LDB T1,[POINTR (FURBTO(T1),FR.OVR)] ; GET OVERRIDE CODE
CAILE T1,1 ; ASK?
JRST DELFA2 ; NO, MUST BE YES
SKIPN $QUIET ; PRINT NAME IF QUIET
JRST DELFA3
PUSHJ P,PRFNMB ; PRINT NAME AND SIZE
PUSHJ P,.TCRLF## ; AND CRLF
DELFA3: PUSHJ P,.TTABC## ; PRINT TAB
MOVEI T1,[ASCIZ .Protected .]
PUSHJ P,.TSTRG## ; PRINT STRING
PUSHJ P,PRTPRT ; PRINT PROTECTION
MOVEI T1,[ASCIZ / against accidental deletion. Delete it anyway/]
PUSHJ P,.TSTRG## ; PRINT WARNING
PUSHJ P,YESNOX ; ASK USER
JRST DELTOT ; !! QUIT
JRST DELFA1 ; NO, DON'T OVERRIDE
DELFA2: MOVE T1,SAVEXT ; [62] Restore extension word before doing rename
MOVEM T1,LUKBLK+.RBEXT ; [62] to preserve date if fails
LOOKUP LUKBLK ; RE-LOOK THE FILE (FILSER LIKE THIS)
JRST DELFA1
MOVEI T1,0 ; SET PROTECTION TO ALL ZEROS
DPB T1,[POINTR (LUKBLK+.RBPRV,RB.PRV)]
RENAME LUKBLK
JRST DELFA1 ; CAN'T
PUSH P,LUKBLK+.RBNAM ; SAVE NAME
SETZM LUKBLK+.RBNAM ; ZERO IT OUT
RENAME LUKBLK
JRST [POP P,LUKBLK+.RBNAM
JRST DELFA1]
POP P,LUKBLK+.RBNAM ; RESTORE NAME
JRST DELADD ; SUCCEEDED!
DELFA1: PUSHJ P,RENFAIL ; REPORT IT
JRST DELOP
E$$CND: MOVEI T1,'CND'
MOVEI T2,[ASCIZ .Could not delete that file.]
JSP T3,FURWARN
PUSHJ P,.TCRLF##
JRST DELOP
E$$FNF: MOVEI T1,'FNF'
MOVEI T2,[ASCIZ .File not found.]
JSP T3,FURWARN
PUSHJ P,.TCRLF##
JRST DELOP
E$$OPN: MOVEI T1,'CNO'
MOVEI T2,[ASCIZ .Can not OPEN that device.]
PJSP T3,FURERR
FURERR: HRLI T1,'FUR' ; PUT ON FUR TAG
HRLI T2,"?" ; FATAL ERROR
PUSHJ P,.ERMSA## ; PRINT ERROR
PUSHJ P,RESCOR ; RETURN ALL USED CORE
PJRST .FMSGE## ; RECOVER, WE HOPE.
FURWARN: ; NOT FATAL; RETURNS CALL WITH JSP T3,FURWARN
PUSH P,T3 ; FAKE PUSHJ
HRLI T1,'FUR'
HRLI T2,"%" ; WARNING ONLY
PUSHJ P,.ERMSA## ; PRINT ERROR
POPJ P, ; GIVE CONTROL BACK WITH T1=WATCH
; BITS FOR MESSAGE IN CASE ROUTINE
; WANTS TO PRINT MORE.
SUBTTL BACKUP PROCESSING
$YBAK: ; ALLOW FILE TO BE BACKED UP
SETZM BAKSWT
SKIPA
$NBAK: SETOM BAKSWT ; BAKSWT IS -1 IF NO BACKUP, 0 IF BACKUP ALLOWED
PUSHJ P,INIFLG ;[71]
PUSHJ P,SCNFIL ; GET FILE NAMES
BAKOP: SETZM TMPMOD ; USE MODE 0
PUSHJ P,GCWILD
JRST .POPJ1 ; EXIT WHEN DONE
SKIPG $DECIDE
JRST NOBDD
MOVEI T1,[ASCIZ .Set .]
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ .no .]
SKIPE BAKSWT
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ .backup for .]
PUSHJ P,.TSTRG##
PUSHJ P,PRFNMB ; PRINT FILE NAME AND SIZE
PUSHJ P,YESNO ; GET ANSWER
JRST .POPJ1 ; IF QUIT, THEN QUIT
JRST BAKOP ; IF NO, THE GOAGAIN
NOBDD:
LDB T1,[POINT 1,BAKSWT,35] ; GET ONE BIT FROM THE SWITCH
DPB T1,[<POINTR (LUKBLK+.RBSTS,RP.NFS)>]
RENAME LUKBLK
JRST [PUSHJ P,RENFAIL
JRST BAKOP]
LDB T1,[<POINTR (LUKBLK+.RBSTS,RP.NFS)>]
XOR T1,BAKSWT
TRNE T1,1 ; DID IT TAKE?
PUSHJ P,[MOVEI T1,[ASCIZ .?Failed .]
PUSHJ P,.TSTRG##
POPJ P,]
SKIPG $DECIDE ; IF DECIDE, DON'T PRINT
SKIPLE $QUIET
JRST BAKOP
PUSHJ P,PRFNMB ; PRINT FILE NAME AND SIZE
PUSHJ P,.TCRLF## ; AND CRLF
JRST BAKOP
SUBTTL ROUTINE TO GET YES OR NO ON A DECIDE OR OVERRIDE
; RESPONSES ARE (IN ORDER OF RETURN QUIT, NO, YES)
YESNO: SKIPG $DECID
JRST YESNO2 ; SIDE EFFECT IS A CRLF
SKIPA T3,[1] ; DECIDE-TYPE ENTRY
YESNOX:
MOVEI T3,0 ; OVERRIDE-TYPE ENTRY
PUSHJ P,CHKBAT ;SEE IF WE'RE BATCH
SKIPA
JRST YESNO2 ; YES, JUST CRLF
SKIPE T3
PUSHJ P,.TSPAC##
MOVEI T1,"?"
PUSHJ P,.TCHAR##
PUSHJ P,.TSPAC##
PUSHJ P,TTYOUT
INCHRW T1
CAIE T1,"Y"
CAIN T1,"y"
JRST YESNO2
CAIE T1,"Q"
CAIN T1,"q"
JRST YESNO0
CAIN T1,"?"
JRST YESNO3
CAIE T1,"H"
CAIN T1,"h"
JRST YESNO3
CAIE T1,"N"
CAIN T1,"n"
JRST YESNO1
CAIE T1,"C"
CAIN T1,"c"
JRST YESNO6
CAIE T1,"G"
CAIN T1,"g"
JRST YESNO4
JUMPE T3,YESNOX ; OVERRIDE STAYS WITH ITSELF
PJRST YESNO
YESNO4: MOVE T1,WLDPTR
JUMPN T3,YESNO5 ; DECIDE-TYPE ENTRY
MOVEI T2,3 ; SET /OVERRIDE:YES
DPB T2,[POINTR (FURBTO(T1),FR.OVR)]
JRST YESNO2 ; AND GO AHEAD WITH IT
YESNO5: MOVX T2,FR.DEC!FR.ADC
ANDCAM T2,FURBTO(T1)
SETZM $DECIDE
YESNO2: AOS 0(P)
YESNO1: AOS 0(P)
YESNO0: PJRST .TCRLF##
YESNO3: OUTSTR [ASCIZ .
[Type Y for Yes, N for No, Q for Quit, or G for Go]
.]
JUMPN T3,YESNO
OUTSTR [ASCIZ .[Type C to continue without overriding protection or asking anymore]
.]
JRST YESNOX
YESNO6: JUMPN T3,YESNO ; IF DECIDE, DON'T RECOGNIZE IT
MOVE T1,WLDPTR
MOVEI T2,2 ; SET /OVERRIDE:NO
DPB T2,[POINTR (FURBTO(T1),FR.OVR)]
JRST YESNO1
SUBTTL SUBROUTINE TO CHECK FOR BATCH
CHKBAT: ; SKIP IF BATCH JOB
; USES T1
SKIPL $BATCH
JRST CHKBA1
HRROI T1,.GTLIM
GETTAB T1,
SETZ T1, ; IF FAILS, NOT BATCH
TXNN T1,JB.LBT
SETZ T1,
SKIPE T1
MOVEI T1,1
MOVEM T1,$BATCH
CHKBA1: SKIPE $BATCH
AOS 0(P)
POPJ P,
SUBTTL PAD
; [63] This entire section comprises the body of the PAD function
$PAD: ; PAD VERB
PUSHJ P,INIFLG ;[71]
MOVEI T1,.IODMP ;SET UP I/O MODE TO USE DUMP
MOVEM T1,TMPMOD ;AND SAVE IT FOR LATER
PUSHJ P,STATIN ;GO INITIALIZE STAT'S
SETZM PADFLG ;CLEAR PROCESSING FLAG TO SHOW ABSOLUTE
PUSHJ P,.TIAUC## ;PRIME THE PUMP
CAIN C,"-" ;CHECK AND SEE IF THEY TRIED TO GIVE NEGATIVE
JRST E$$CSN ;AND GIVE ERROR
CAIN C,"+" ;ADDITIONAL BLOCKS?
JRST $PAD1 ;YES
CAIE C,"*" ;MULTIPLY?
JRST $PAD2 ;NO
SOS PADFLG ;FLAG AS MULTIPLY (-1)
PUSHJ P,.TIAUC## ;PASS OVER THE "*"
PUSHJ P,.DECNC## ;GET VALUE TO MULTIPLY WITH
JUMPL N,E$$CSN ;GO GIVE ERROR IF NOT POSITIVE
JRST $PAD3 ;AND CONTINUE NORMAL PROCESSING
$PAD1: AOS PADFLG ;FLAG AS ADDITION (1)
PUSHJ P,.TIAUC## ;PASS OVER THE "+" OR "*"
$PAD2: PUSHJ P,.BLOKC## ;GET # OF BLOCKS TO PAD
$PAD3: JUMPE N,E$$CNZ ;KILL THEM IF THEY GAVE 0 BLOCK SIZE
MOVEM N,PADSIZ ;SAVE FOR LATER
PUSHJ P,SCNFIL ;GET FILENAMES
PADOP: PUSHJ P,GCWILD ;CALL WILD
JRST PADTOT ;EXIT WHEN WE ARE THRU
MOVEI T1,0 ;GET DEV CHARACTERISTICS FOR THIS CHAN
DEVCHR T1, ;THE DEVICE CHARACTERISTICS IN T1
TXNN T1,DV.DSK ;CHECK TO SEE IF WE HAVE A DISK UNIT
JRST E$$DMD ;IF NOT GIVE ERROR
MOVE T1,PADSIZ ;IF NOT ABSOLUTE PROCESSING
;THEN BYPASS THESE ELSE GET SIZE GIVEN
SKIPN T2,PADFLG ;GET FLAG FOR TYPE OF PROCESSING
JRST CHKSIZ ;GO CHECK FOR CORRECT USER SIZE
$PAD4: JUMPG T2,$PAD5 ;IF NOT MULTIPLY PROCESSING THEN
SKIPN .RBSIZ+LUKBLK ;TEST FOR 0 BLOCKSIZE
JRST E$$CMZ ;IF 0BLOCKSIZE KILL THEM
IMUL T1,.RBSIZ+LUKBLK ;AND MULTIPLY IT
JRST CHKSIZ ;AND GO CHECK THE REQUESTED VALUE
$PAD5: MOVE T2,PADSIZ ;GET PADSIZ LENGTH
ADD T1,.RBSIZ+LUKBLK ;AND ADD AMOUNT OF FILE ALREADY
CONT.
CHKSIZ: CAMGE T1,.RBSIZ+LUKBLK ;CHECK TO MAKE SURE THEY HAVEN'T
;ASKED US TO DECREASE THE FILES SIZE
JRST E$$CDF ;GO GIVE ERROR
ADDI T1,177 ;ROUND UP TO NEAREST BLOCK
TRZ T1,177 ;CLEAR REMAINDER
MOVEM T1,PADNSZ ;AND SAVE FOR LATER
MOVE T1,.RBSIZ+LUKBLK ;GET OLD COUNT FOR
ADDI T1,177 ;USE LATER ON AS ROUNDED FIGURE
TRZ T1,177 ;CLEAR REMAINDER
MOVEM T1,PADOSZ ;AND SAVE FOR LATER
PUSHJ P,PRTPOP ;SEE IF WE MUST PRINT
JRST $NODECI ;NO SO BYPASS THIS MESS
PUSHJ P,PRFNAM ;GO PRINT THE FILENAME
PUSHJ P,.TSPAC## ;GET READY FOR BLOCKSIZE
MOVE T1,PADOSZ ;GET OLD FILE SIZE IN WORDS
LSH T1,-7 ;AND CONVERT IT TO BLOCKS
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ " --"]
PUSHJ P,.TSTRG## ;TYPE SOME MORE
MOVEI T1,76 ;FAKE OUT MACRO 53 BY USING OCT 76 INSTEAD OF
;CLOSING ANGLE BRACKET
PUSHJ P,.TCHAR## ;WRITE IT OUT
PUSHJ P,.TSPAC## ;AND A SPACE
PUSHJ P,PRFNAM ;GO PRINT THE FILENAME
PUSHJ P,.TSPAC##
MOVE T1,PADNSZ ;GET NEW BLOCKSIZE IN WORDS
LSH T1,-7 ;CONVERT TO BLOCKS BEFORE PRINTING
PUSHJ P,.TDECW## ;AND WRITE IT OUT
PUSHJ P,.TSPAC## ;WRITE OUT THE LAST BIT
PUSHJ P,YESNO ;AND SEE IF WE NEED TO CONTINUE
JRST PADTOT ;IF QUIT GO BACK. AFTER GIVING TOTALS IF ANY.
JRST PADOP ;IF NO TRY ANOTHER FILE
CONT.
$NODECI: ;HERE IF DECIDE OPTION NOT REQUESTED
ENTER LUKBLK ;DO ENTER TO GET INTO UPDATE MODE
JRST [PUSHJ P,ENTFAIL
JRST PADOP ] ;TELL ABOUT ENTER ERROR AND TRY ANOTHER ONE
MOVE T1,PADNSZ ;GET THE NEW FILE SIZE IN WORDS
CAMG T1,PADOSZ ;SEE IF WE ACTUALLY HAVE TO DO ANYTHING
JRST $PAD6 ;IF NOT THEN JUST BYPASS EVERYTHING
LSH T1,-7 ;CONVER # OF WORDS INTO # OF BLOCKS
USETO (T1) ;POSITION TO PLACE TO WRITE NULL BLOCK
MOVEI T3,200 ;AMOUNT OF CORE NEEDED
PUSHJ P,SPACE ;GO GET SOME CORE
HRL T2,T1 ;T1 HAS STARTING LOCATION OF OUR 200 WORD BUFFER
HRRI T2,1(T1) ;LOAD SOURCE AND DESTINATION ADDR FOR BLT
SETZM (T1) ;CLEAR THE FIRST WORD
BLT T2,200(T1) ;AND LET THE BLT DO THE REST
SUBI T1,1 ;DECREMENT LOCATION BY 1 FOR IOWD
HRLI T1,-200 ;MAKE T1 INTO A COMMAND LIST
SETZ T2, ;AND CLEAR T2
OUT 0,T1 ;COMMAND LIST IS IN T1
CAIA ;OUT HAS A FUNNY GOOD RETURN
JRST [GETSTS 0,T2 ;GET STATUS INTO T2
PUSHJ P,DOIOERR ;GO SEE WHAT HAPPENED
JRST PADOP] ;AND TRY FOR ANOTHER FILE
CONT.
$PAD6: CLOSE ;CLOSE THE OUTPUT CHANNEL
RELEAS ;AND RELEASE IT
PADADD: MOVE T1,PADNSZ ;GET NEW FILE WORD SIZE
SUB T1,PADOSZ ;AND SUBTRACT OLD VALUE FROM IT
PUSHJ P,ADDWDS ;GO ADD NUM WORDS PADDED
PUSHJ P,ADDFIL ;AND ADD ANOTHER FILE
MOVE T1,PADOSZ ;AND GET THE OLD VALUE FOR TYPEOUT
JRST PADOP ;AND LOOP BACK FOR ANOTHER ONE
PADTOT: PUSHJ P,STATOU ;GO WRITE STATISTICS
MOVEI T1,[ASCIZ . Padded.]
SKIPE PRTSUM
PUSHJ P,.TSTRG## ;AND WRITE IT OUT
PUSHJ P,STATFI ;FINISH THE STATS
JRST .POPJ1## ;AND RETURN
CONT.
E$$CSN: ;PAD SIZE GIVEN WAS NEGATIVE
MOVEI T1,'CSN' ;USER HAS GIVEN INCORRECT ANSWER
MOVEI T2,[ASCIZ .Cannot specify negative Pad size.]
PJSP FURERR ;GO GIVE ERROR
E$$CDF: ;HERE IF TRIED TO DECREASE THE FILE'S SIZE
MOVEI T1,'CDF' ;GIVE PREFIX
MOVEI T2,[ASCIZ .Cannot decrease the size of .]
PJSP T3,FURWARN ;GO GIVE ERROR
MOVEI T1,OPNBLK ;POINT TO OPEN BLOCK
MOVEI T2,LUKBLK ; LOOKUP BLOCK
PUSHJ P,.TOLEB## ;GO GIVE FILE NAME
PUSHJ P,.TCRLF## ;GIVE CRLF PAIR
JRST PADOP ;AND GO TRY ANOTHER FILE
E$$CNZ: ;HERE IF THEY WERE DUMB ENOUGH TO SAY 0B
MOVEI T1,'CNZ' ;LOAD ERROR CODE
MOVEI T2,[ASCIZ .Cannot give Pad value of 0.]
PJSP FURERR ;GO GIVE ERROR
E$$CMZ: ;HERE IF TRING TO MULTIPLY WITH A FILE THAT
;HAS A 0 BLOCKSIZE
MOVEI T1,'CMZ' ;GIVE ERROR PREFIX
MOVEI T2,[ASCIZ .Cannot multiply a file with zero blocksize - File: .]
PJSP T3,FURWARN ;GO GIVE PART OF MESSAGE
MOVEI T1,OPNBLK ;POINT TO OPEN BLOCK
MOVEI T2,LUKBLK ; LOOKUP BLOCK
PUSHJ P,.TOLEB## ;GO PRINT FILENAME
PUSHJ P,.TCRLF## ;GIVE CRLF PAIR
JRST PADOP ;AND TRY FOR ANOTHER ONE
E$$DMD: MOVEI T1,'DMD' ;LOAD ERROR CODE
MOVEI T2,[ASCIZ .Device must be a disk type unit - File: .]
PJSP T3,FURWARN ;GO GIVE ERROR MESSAGE
MOVEI T1,OPNBLK ;POINT TO OPEN BLOCK
MOVEI T2,LUKBLK ; LOOKUP BLOCK
PUSHJ P,.TOLEB## ;AND GO PRINT THE FILENAME
PUSHJ P,.TCRLF## ;GIVE CRLF PAIR
JRST PADOP ;AND LOOP BACK FOR ANOTHER ONE
IFN FT$ISM,< ; [73] add DUMP command to dump an ISAM index
; [73] statistics block
SUBTTL DUMP
$DUMP: ; [73] Dump verb, dumps given isam files.
PUSHJ P,.SAVE2## ; [73] Save perm acs that we use
PUSHJ P,INIFLG ; [71][73] INITIALIZE FLAGS
SETOM DODUMP ; [73] Flag that we are doing a dump command
MOVEI T1,.IODMP ; [73] Set up for dump mode read
MOVEM T1,TMPMOD ; [73] And remember for later
MOVEI T3,^D50 ; [73] Need this much space for the stat block
PUSHJ P,SPACE ; [73] Go get it
MOVE T2,[IOWD ^D50,0]
; [73] Set up a command list
HRRI T2,-1(T1) ; [73] Load the address
MOVEM T2,DUMCMD ; [73] Remember it
PUSHJ P,SCNFIL ; [73] Go get the files
DUMOP: PUSHJ P,GCWILD ; [73] Go resolve any wild specs
JRST DMPTOT ; [73] No more files we are thru
MOVE T2,DUMCMD ; [73] Get command list
SETZ T3, ; [73]
IN 0,T2 ; [73] Do the input operation
JRST DUMSTA ; [73] No errors go show the stat's
GETSTS 0,T2 ; [73] Get statistics for chan 0
PUSHJ P,DOIOERR ; [73] Go translate the error
JRST DUMOP ; [73] Loop back for more files if there
DUMSTA: HRRI P1,1(T2) ; [73] Save index since scan will use t1
MOVE T1,WLDPTR ; [73] Get pointer to this file
LDB T1,[POINTR (FURBTO(T1),FR.OVR)]
; [73] We won't check for isam if override = yes
CAIN T1,3 ; [73] Is it override:yes?
JRST DUMST1 ; [73] YES so don't check.
HLRZ T1,^D0(P1) ; [73] Get header word
CAIE T1,401 ; [73] Check for an ISAM index block
JRST E$$NII ; [73] If not one then give error and stop
DUMST1: MOVEI T1,[ASCIZ .[Isam Statistics Block Dump for .]
PUSHJ P,.TSTRG## ; [73] Give some sort of file header
PUSHJ P,PRFNAM ; [73] Print file name
MOVEI T1,"]" ; [73] Terminate the message
PUSHJ P,.TCHAR##
PUSHJ P,.TCRLF## ; [73] and give a crlf sequence
MOVSI P2,-ISMSIZ ; [73] Load size of tables-unused entries
ISMTYP: PUSHJ P,ISMTYS ; [73] Go set up temp buffer for typeout for alignment
MOVE T1,ISMT1(P2) ; [73] Get offset for this value in stat block
ADD T1,P1 ; [73] Point to the item in stat block
MOVE T1,(T1) ; [73] Get the value to print
PUSHJ P,@ISMT2(P2) ; [73] And print with the correct routine
MOVE T1,ISMT1(P2) ; [73] See if we must end a quote or type a decimal point
PUSHJ P,ISMTYF ; [73] Go reset scan typeout and do justification
MOVE T1,ISMT3(P2) ; [73] And print descriptive text
PUSHJ P,.TSTRG##
PUSHJ P,.TCRLF## ; [73] followed with a CRLF sequence
AOBJN P2,ISMTYP ; [73] And loop until everything has finished
PUSHJ P,.TCRLF## ; [73] Give free crlf at end to seperate wild dumps
CLOSE 0, ; [73] Close the channel
RELEAS 0, ; [73] And release it before getting next file if any
JRST DUMOP ; [73] Done go loop back for more
DMPTOT: ; [73] Here when done and returing
SETZM DODUMP ; [73] Remember we are no longer doing a dump
JRST .POPJ1## ; [73] Then return
$TDECW: ; [73] This routine prints a decimal number followed by a decimal point
PUSHJ P,.TDECW## ; [73] First let scan print the number
MOVEI T1,"." ; [73] Then print the decimal point
PJRST .TCHAR## ; [73] Again use scan
$TSIXN: ; [73] This routine print a sixbit quoted string in t1
PUSH P,T1 ; [73] Save the actual value
MOVEI T1,"'" ; [73] Type the lead in quote
PUSHJ P,.TCHAR##
POP P,T1 ; [73] Then get back real value
PUSHJ P,.TSIXN## ; [73] Type it using scan
MOVEI T1,"'" ; [73] Then follow by end quote
PJRST .TCHAR## ; [73] with scan again
.TMODW: ; [73] This routine prints the recording mode of the data file
LDB T2,[POINT 2,T1,19]
; [73] Get the Recording mode
SKIPN T2 ; [73] 0 means sixbit
MOVEI T1,[ASCIZ .Sixbit.]
CAIN T2,1 ; [73] 1 means ebcdic
MOVEI T1,[ASCIZ .Ebcdic.]
CAIN T2,2 ; [73] 2 means ascii
MOVEI T1,[ASCIZ .Ascii.]
CAIN T2,3 ; [73] Just in case
MOVEI T1,[ASCIZ .Unknown.]
PJRST .TSTRG## ; [73] Now tell user which one it is
.TKEYN: ; [73] Type out the isam key descriptor
MOVE T4,T1 ; [73] Save the word so we can get everything
LDB T2,[POINT 18,T4,17] ; [73] Get the type of key
SKIPE T2 ; [73] If zero then can't be signed (non-numeric)
PUSHJ P,[LDB T3,[POINT 1,T4,20]
; [73] get sign flag
SKIPE T3 ; [73] if 0 then signed
SKIPA T1,["U"]
MOVEI T1,"S"
PJRST .TCHAR##];[73] Tell user which one it is
CAIL T2,^D9 ; [73] Make sure it is range before doing anything with it
MOVEI T2,^D9 ; [73] Else set to unknown
MOVE T1,["X" ; [73] non-numeric display
"N" ; [73] 1-word numeric display
"N" ; [73] 2-word numeric display
"C" ; [73] 1-word comp (fixed point)
"C" ; [73] 2-word comp (fixed point)
"F" ; [73] 1-word floating point
"F" ; [73] 2-word floating point (COBOL does not support this!!)
"P" ; [73] 1-word comp-3 packed decimal
"P" ; [73] 2-word comp-3 packed decimal
"?"](T2) ; [73] GET THE APPROPRIATE DESCRIPTOR
PUSHJ P,.TCHAR## ; [73] AND TYPE IT
LDB T2,[POINT 2,T4,19];[73] Key recording mode
HRRZ T3,^D35(P1) ; [73] Get word offset into record
SKIPN T2 ; [73] If type is 0 then SIXBIT
IMULI T3,6
CAIN T2,1 ; [73] if type is 1 then EBCDIC
IMULI T3,4
CAIN T2,2 ; [73] if type is 2 then ASCII
IMULI T3,5
PUSH P,T3 ; [73] Save so we can use the ac
LDB T3,[POINT 6,^D35(P1),5];[73] Get the bits to right of our byte
PUSH P,T4 ; [73] save ac so we don't clobber it with divides
MOVNS T3 ; [73] Make negative
ADDI T3,^D36 ; [73] Get bits to the left
SKIPN T2 ; [73] Do correct divide based on the
IDIVI T3,6 ; [73] mode of the file
CAIN T2,1
IDIVI T3,4 ; [73] EBCDIC
CAIN T2,2
IDIVI T3,5 ; [73] ASCII
POP P,T4 ; [73] Restore our key descriptor word
POP P,T1 ; [73] Get bytes to left of starting byte into t1
ADDI T1,1(T3) ; [73] Add in what we just figured
PUSHJ P,.TDECW## ; [73] Write it
MOVEI T1,"."
PUSHJ P,.TCHAR## ; [73] Give seperator
LDB T1,[POINT 12,T4,35] ; [73] Now give the size of the key
PJRST .TDECW## ; [73] And write it
E$$NII: MOVEI T1,'NII' ; [73] Give error prefix
MOVEI T2,[ASCIZ .Not an Isam Index file .]
JSP T3,FURWARN ; [73] Issue warning
JFCL
PUSHJ P,PRFNAM ; [73] Go give the filename
PUSHJ P,.TCRLF##
PUSHJ P,.TCRLF##
JRST DUMOP ; [73] And loop for more files
ISMTYS: ; [73] THIS ROUTINE SETS UP SO WE CAN DO FANCY ALIGNMENT
MOVEI T1,DUMTYP ; [73] POINT TO THE TYPEING ROUTINE
PUSHJ P,.TYOCH## ; [73] TELL SCAN ABOUT IT
SETZM BYTCNT ; [73] SET OUR BYTE COUNT TO ZERO
MOVE T1,ISMBPT ; [73] GET BYTE POINTER TO THE TEMP AREA
MOVEM T1,DUMBPT ; [73] SAVE FOR TYPEOUT ROUTINE
POPJ P, ; [73] THEN RETURN
DUMTYP: ; [73] THIS ROUTINE ACCUMULATES THE DATA TO BE SHOWN
IDPB T1,DUMBPT ; [73] DEPOSIT THE BYTE INTO TEMP AREA
AOS BYTCNT ; [73] ADD ONE TO OUR BYTE COUNTER
POPJ P, ; [73] AND RETURN TO SCAN FOR MORE
ISMTYF: ; [73] THIS ROUTINE FINISHS THE FANCY ALIGNMENT BY
; [73] TYPING SPACES REQUIRED TO RIGHT JUSTIFY THE DATA
SETZ T1, ; [73] END OUR TEXT WITH A NULL
IDPB T1,DUMBPT
MOVEI T1,OUTONE ; [73] RESTORE FUR'S OWN TYPEOUT ROUTINES
PUSHJ P,.TYOCH## ; [73] TELL SCAN
MOVEI T4,^D13 ; [73] GET OUR FIELD WIDTH
SUB T4,BYTCNT ; [73] SEE HOW MANY SPACES WE NEED
SKIPLE T4 ; [73] NONE IF IT IS FULL
PUSHJ P,.TSPAC## ; [73] ELSE TYPE SOME SPACES
SOJG T4,.-1 ; [73] LOOP TILL WE ARE DONE
MOVEI T1,DUMTMP ; [73] POINT TO THE TEMP BUFFER
PJRST .TSTRG## ; [73] TYPE IT AND THEN AND RETURN TO SCAN
.DIRECTIVE NO FLBLST ; UNDO MACRO EXPANSION SUPPRESSION
> ;end of ifn ft$ism
SUBTTL FIND
$FIND: ; FIND VERB, FINDS GIVEN FILES
PUSHJ P,INIFLG ;[71]
SETOM DOFIND ; DOING FIND
PUSHJ P,STATIN ; INITIALIZE STATISTICS
PUSHJ P,SCNFIL ; GET FILE NAMES
SETZM DOFIND ; THAT'S ENOUGH
FNDLOP: SETZM TMPMOD ; USE MODE 0
PUSHJ P,GCWILD
JRST FNDTOT ; PRINT TOTALS
PUSHJ P,PRFNMB ; PRINT FILE NAME AND SIZE
MOVE T1,LUKBLK+.RBALC
LSH T1,^D7
PUSHJ P,ADDWDS ; ADD FILE SIZE
PUSHJ P,ADDFIL
LDB T1,[POINT 9,LUKBLK+.RBPRV,8]
CAIE T1,^O055
CAIN T1,^O155
JRST NOPPRIV
PUSHJ P,.TSPAC##
PUSHJ P,PRTPRT ; PRINT PROTECTION CODE
NOPPRIV: PUSHJ P,.TTABC## ; TAB
LDB T1,[POINT 3,LUKBLK+.RBEXT,20]
LSH T1,^D12
LDB T2,[POINT 12,LUKBLK+.RBPRV,35]
IOR T1,T2
PUSHJ P,.TDATE## ; PRINT DATE
SKIPE T1,LUKBLK+.RBSPL ; GET SPOOL NAME
PUSHJ P,.TTABC ; TAB
SKIPE T1,LUKBLK+.RBSPL
PUSHJ P,.TSIXN##
SKIPE T1,LUKBLK+.RBVER ; GET VERSION IF ANY
PUSHJ P,.TTABC## ; TAB
SKIPE T1,LUKBLK+.RBVER
PUSHJ P,.TVERW## ; TYPE VERSION
SKIPN T1,LUKBLK+.RBPPN ; GET CURRENT PPN FOR THIS FILE
MOVE T1,ORGDIR ; GET ORIGINAL DIRECTORY IF BLANKED
TLNN T1,-1 ; PATH POINTER?
MOVE T1,.PTPPN(T1)
SKIPE LUKBLK+.RBAUT ; ANY AUTHOR THERE?
CAMN T1,LUKBLK+.RBAUT ; GET AUTHOR
JRST FDON1 ; GET NEXT
PUSHJ P,.TTABC## ; TAB
MOVEI T1,[ASCIZ .Author=.]
PUSHJ P,.TSTRG##
MOVEI T1,LUKBLK+.RBAUT
PUSHJ P,.TDIRB## ; PRINT AUTHOR
PUSHJ P,.TSPAC##
FDON1: ;
MOVE T2,LUKBLK+.RBSTS
MOVEI T1,[ASCIZ . Logged-in.]
TXNE T2,RP.LOG
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Checksum-errors-exist.]
TXNE T2,RP.UCE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Data-errors-exist-while-writing.]
TXNE T2,RP.UWE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Data-errors-exist-while-reading.]
TXNE T2,RP.URE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Can't-delete.]
TXNE T2,RP.NDL
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . No-backup.]
TXNE T2,RP.NFS
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Always-bad-checksum.]
TXNE T2,RP.ABC
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Always-backup.]
TXNE T2,RP.ABU
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Non-quota-checked.]
TXNE T2,RP.NQC
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . UFD-compression.]
TXNE T2,RP.CMP
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Software-checksum-error.]
TXNE T2,RP.FCE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Hard-data-error-writing.]
TXNE T2,RP.FWE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Hard-data-error-reading.]
TXNE T2,RP.FRE
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Bad-file-tape-error.]
TXNE T2,RP.BFA
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Closed-after-crash.]
TXNE T2,RP.CRH
PUSHJ P,.TSTRG##
MOVEI T1,[ASCIZ . Marked-bad.]
TXNE T2,RP.BDA
PUSHJ P,.TSTRG##
FDON: PUSHJ P,.TCRLF##
JRST FNDLOP
FNDTOT: MOVE T1,NUMFIL
CAILE T1,1 ; MORE THAN ONE FILE?
PUSHJ P,STATOU
PUSHJ P,STATFI
JRST .POPJ1##
SUBTTL RENAME COMMAND
$REN: ; RENAME COMMAND
JUMPLE C,.POPJ1##
PUSHJ P,INIFLG ;[71]
PUSHJ P,STATIN ; INITIALIZE STATISTICS
PUSHJ P,FILIN$ ; GET FILE NAME
PUSHJ P,$CLSNS ; CLEAR STICKY DEFAULTS IN SCAN
MOVEI T1,S.DEST ; PUT IN DESTINATION AREA
MOVEI T2,$FXLEN
PUSHJ P,$GTSPC
CAIE C,"="
CAIN C,"_"
SKIPA
JRST RENSE$ ; SEPARATOR MUST BE = OR _
PUSHJ P,SCNFIL ; GET OUTPUT FILE NAMES
RENLOP: SETZM TMPMOD
PUSHJ P,GCWILD
JRST RENDON ; DONE RENAMING
SETZM PTHBLK
MOVE T1,[XWD PTHBLK,PTHBLK+1]
BLT T1,PTHBLK+.PTMAX-1
MOVE T1,[XWD .PTMAX,PTHBLK]
PATH. T1, ; GET ITS PATH
JFCL ; IF CAN'T JUST DON'T USE
MOVE T1,PTHBLK+.PTSWT
TXNN T1,PT.IPP ; IS PPN FORCED?
JRST PTHNPF ; NO
MOVE T1,S.DEST+.FXMOD
TXNE T1,FX.NDV ; DEVICE SPECIFIED FOR OUTPUT?
TXNE T1,FX.DIR ; DIRECTORY SPECIFIED FOR OUTPUT?
SKIPA
JRST PTHNPF ; NO DEVICE AND NO DIRECTORY
MOVE T1,LUKBLK+.RBDEV; YES, WE MUST RE-LOOK THIS FILE
MOVEM T1,OPNBLK+1 ; SET NEW DEVICE FOR OPEN
MOVEI T1,PTHBLK
MOVEM T1,LUKBLK+.RBPPN
PUSHJ P,DOOLK ; AND LOOK UP AGAIN
JRST RENCR$ ; CAN'T RENAME
PTHNPF:
PUSHJ P,UPDBLK ; MAKE OUTPUT BLOCK
JRST RENCR$
SETZ T1, ; CLEAR T1 AND USE TO ACCUMULATE RIB LENGTH
MOVE T2,U.DEST+FURSTA ; GET STATUS SWITCH VALUE IF GIVEN
CAME T2,[-1] ; SEE IF A VALUE WAS GIVEN
JRST [PUSHJ P,UPDSTA ; [73] Go set the status bits given by user
MOVEM T1,LUKBL1+.RBSTS; [73] Store user set status bits
MOVEI T1,.RBSTS ; [73] Must use at least this much of enter block
JRST .+1] ; [73] Now test author switch
MOVE T2,U.DEST+FURAUR ; [73] See if we must set author switch
CAME T2,[-1] ; [73] If -1 then not set
PUSHJ P,SETAUR ; [73] Well go see then
SKIPN T1 ; [73] See if we must use a prespecified length
MOVEI T1,.RBSPL ; [73] No so default to this
MOVEM T1,LUKBL1+.RBCNT ; SINCE WE CAN DESTROY THINGS ACCIDENTALLY
PUSHJ P,PRTPOP ; PRINT STUFF?
JRST RENGOD ; NO
PUSHJ P,PRFNAM ; PRINT FILE NAME
MOVEI T1,[ASCIZ .-->.]
PUSHJ P,.TSTRG##
MOVEI T1,OPNBL1
MOVEI T2,LUKBL1
PUSHJ P,.TOLEB## ; PRINT THIS STUFF TOO
PUSHJ P,YESNO ; THIS DOES CRLF TOO
JRST RENDON
JRST RENLOP ; DON'T DO IT
RENGOD: RENAME LUKBL1 ; THAT WAS IT
JRST UFDRER ; ERROR
PUSHJ P,ADDFIL ; COUNT FILES
JRST RENLOP
RENDON: PUSHJ P,STATOU
PUSHJ P,STATFI
JRST .POPJ1##
SETAUR: ; [73] Here to set AUTHOR on output
MOVE T3,U.DEST+FURAUM ; [73] Make sure it is not wild
CAME T3,[-1] ; [73] -1 means not wild
JRST WLDAUR ; [73] He is trying a no-no.
MOVEM T2,LUKBL1+.RBAUT ; [73] Not wild just set and return
MOVEI T1,.RBAUT ; [73] Say rename must use at least this much
JRST .POPJ## ; [73] Return
WLDAUR: ; [73] Here if user is attempting the impossible
MOVEI T1,'CWA' ; [73] Tell him off
MOVEI T2,[ASCIZ .Cannot use wildcards in output AUTHOR switch.]
PJSP T3,FURERR ; [73] Go kill him!
UFDRER: ; RENAME ERROR NEEDS BLOCK IN LUKBLK
PUSHJ P,EXCBLK ; EXCHANGE BLOCKS
PUSHJ P,RENFAI
JFCL
PUSHJ P,EXCBLK
JRST RENLOP
EXCBLK: ; EXCHANGE OPNBLK THROUGH LUKBLK WITH OPNBL1 AND LUKBL1
MOVEI T1,OPNBLK
MOVEI T2,OPNBL1
EXCBL1: CAIN T1,LUKBLK+$FXLEN
POPJ P,
MOVE T3,(T1)
EXCH T3,(T2)
MOVEM T3,(T1)
AOS T2
AOJA T1,EXCBL1
RENSE$: MOVEI T1,'SMB'
MOVEI T2,[ASCIZ .Separator must be =.]
PJSP T3,FURERR
RENCR$: MOVEI T1,'CNF'
MOVEI T2,[ASCIZ .Cannot RENAME file(s).]
PJSP T3,FURERR
SUBTTL ROUTINE TO SETUP OUTPUT SPEC
UPDBLK: ; THIS ROUTINE TAKES THE FILE DESCRIBED IN LUKBLK
; AND SETS UP OPNBL1 AND LUKBL1 TO "MATCH"
; SETUP OF OPNBL1 IS NOT DONE YET
SETZM OPNBL1
SETZM OPNBL1+1
SETZM OPNBL1+2
SETZM LUKBL1
MOVE T1,[XWD LUKBL1,LUKBL1+1]
BLT T1,LUKBL1+RIBSIZ-1
SETZM PTHBL1
MOVE T1,[XWD PTHBL1,PTHBL1+1]
BLT T1,PTHBL1+.PTMAX-1
MOVE T1,[XWD S.DEST,U.DEST]
BLT T1,U.DEST+$FXLEN-1 ; COPY SPEC
; BEFORE CHANGING THINGS
MOVE T1,U.DEST+.FXNMM ; CHANGE A WILD NAME
SETCM T2,T1 ; MAKE A COMPLEMENT COPY
AND T1,U.DEST+.FXNAM ; BITS SPECIFIED BECOME REAL
AND T2,LUKBLK+.RBNAM ; AND WILDS ARE GOTTEN FROM INPUT
IOR T1,T2 ; PUT THESE TOGETHER
MOVEM T1,U.DEST+.FXNAM
SETOM U.DEST+.FXNMM ; SO MUCH FOR NAME
HRLO T1,U.DEST+.FXEXT ; NOW EXTENSION
SETCM T2,T1
AND T1,U.DEST+.FXEXT
AND T2,LUKBLK+.RBEXT
IOR T1,T2
HLLOM T1,U.DEST+.FXEXT ; PUT BACK FIXED EXTENSION
; NOW CHECK UP ON DEVICE PART
MOVE T4,U.DEST+.FXMOD ; GET MODIFIERES
MOVE T2,OPNBLK+1 ; GET OLD DEVICE
TXNN T4,FX.DIR ; DIRECTORY SPECIFIED?
TXNE T4,FX.NDV ; DEVICE SPECIFIED?
SKIPA
JRST UFDBL4 ; NO, USE DEVICE PATH
; NOW WORK ON DIRECTORY
SETZ T3, ; START AT FIRST ONE
UFDBL1: CAIL T3,.FXLND ; MAKE SURE STILL IN RANGE
JRST UFDBL2 ; NO
LSH T3,1 ; MAKE DOUBLEWORD INDEX
MOVE T1,U.DEST+.FXDIR(T3) ; GET DIRECTORY
MOVE T2,U.DEST+.FXDIM(T3) ; AND ITS MODIFIER
LSH T3,-1 ; PUT BACK T3
JUMPE T1,[JUMPE T2,UFDBL2
JRST .+1]
AND T1,T2
SETCMM T2 ; COMPLEMENT IT
AND T2,PTHBLK+.PTPPN(T3) ; AND PUT IN APPROPRIATE PPN OR SFD
IOR T1,T2
MOVE T2,T3
ADD T2,T3
MOVEM T1,U.DEST+.FXDIR(T2) ; AND STORE RESULT
SETOM U.DEST+.FXDIM(T2)
AOJA T3,UFDBL1 ; AND DO NEXT IF NEEDED
UFDBL4: ; HERE WHEN NO DIRECTORY WAS SPECIFIED ON OUTPUT
; USE DEVICE PATH DIRECTORY
PUSHJ P,UFDGDP
SETZ T3,
UFDBL5: CAIL T3,.FXLND
JRST UFDBL2
MOVE T1,PTHGDP+.PTPPN(T3)
JUMPE T1,UFDBL2
LSH T3,1
MOVEM T1,U.DEST+.FXDIR(T3)
SETOM U.DEST+.FXDIM(T3)
LSH T3,-1
AOJA T3,UFDBL5
UFDBL2: ; DONE WITH DIRECTORY, FIX UP MODIFIER WORD
MOVX T1,FX.NDV!FX.NUL!FX.DIR
ANDCAM T1,U.DEST+.FXMOD
IORM T1,U.DEST+.FXMOM ; CLEAR THESE BITS
MOVX T1,FX.DIR
SKIPE U.DEST+.FXDIM
IORM T1,U.DEST+.FXMOD
MOVE T1,U.DEST+FURBTO
TXNE T1,FR.NFP
SKIPA T1,U.DEST+.FXVER
MOVE T1,LUKBLK+.RBVER ; GET OLD VERSION NUMBER
MOVE T2,U.DEST+.FXVER ; SEE IF NEW VERSION NUMBER
CAMN T2,[-1] ; CHECK AGAINST DEFAULT -1
MOVEM T1,U.DEST+.FXVER ; KEEP OLD VERSION NUMBER
MOVE T1,[XWD $FXLEN,U.DEST] ; SCAN BLOCK
MOVEI T2,OPNBL1 ; OPEN BLOCK
MOVE T3,[XWD RIBSIZ-1,LUKBL1]; LOOKUP BLOCK
MOVEI T4,PTHBL1 ; PATH BLOCK
PUSHJ P,.STOPB## ; CONVERT
POPJ P, ; CAN'T
MOVE T1,U.DEST+FURSPL
CAME T1,[-1] ; DON'T STORE -1
MOVEM T1,LUKBL1+.RBSPL ; COPY SPOOL SWITCH GIVEN
MOVE T1,U.DEST+FURBTO
TXNE T1,FR.NFP
JRST SKPFP1
SKIPN T1,LUKBLK+.RBAUT ; COPY AUTHOR
MOVE T1,.MYPPN##
MOVEM T1,LUKBL1+.RBAUT ; TO NEWLY RENAMED FILE
MOVE T1,U.DEST+FURSPL ; GET OUTPUT SPOOL SWITCH, IF PRESENT
CAMN T1,[-1]
MOVE T1,LUKBLK+.RBSPL ; COPY SPOOLED NAME
MOVEM T1,LUKBL1+.RBSPL
MOVE T1,LUKBLK+.RBNCA ; KEEP THIS GUY TOO
MOVEM T1,LUKBL1+.RBNCA
MOVE T1,LUKBLK+.RBMTA
MOVEM T1,LUKBL1+.RBMTA
MOVE T1,[LUKBLK+.RBQTF,,LUKBL1+.RBQTF]
BLT T1,LUKBL1+.RBUSD ; KEEP QUOTAS AND .RBUSD
MOVE T1,LUKBLK+.RBPCA
MOVEM T1,LUKBL1+.RBPCA
MOVE T1,LUKBLK+.RBSTS ; COPY SELECTED PORTIONS OF STATUS
UFSBL1: TXZ T1,RP.UCE!RP.UWE!RP.URE
MOVEM T1,LUKBL1+.RBSTS ; STORE NEW .RBSTS
MOVE T1,[LUKBLK+.RBTIM,,LUKBL1+.RBTIM]
BLT T1,LUKBL1+.RBAC8 ; COPY .RBTIM (INTERNAL TIME),
; .RBLAD (LAST ACCOUNTING DATE),
; .RBDED (DIRECTORY EXPIRATION DATE),
; .RBACT (ACCOUNT STRING)
SKPFP1: SKIPE T1,LUKBL1+.RBPPN ; SEE IF PPN THERE
TLNN T1,777777 ;OR ALREADY PATH SETUP
JRST RSUPTH ;ALREADY OK
SETZM PTHBL1
SETZM PTHBL1+1
MOVEM T1,PTHBL1+2
SETZM PTHBL1+3
MOVEI T1,PTHBL1
MOVEM T1,LUKBL1+.RBPPN ;ALWAYS USE PATH BLOCK
RSUPTH:
MOVEI T1,RIBSIZ-1
IORM T1,LUKBL1+.RBCNT ; PUT IN LENGTH
JRST .POPJ1## ; SUCCESS RETURN
UFDGDP:
; IF HERE, DEVICE WAS SPECIFIED; USE ITS PATH
SETZM PTHGDP+1
MOVE T1,[XWD PTHGDP+1,PTHGDP+2]
BLT T1,PTHGDP+.PTMAX-1 ; CLEAR OUT PATH BLOCK
MOVE T1,U.DEST+.FXDEV
MOVEM T1,PTHGDP ; OVERRIDE OLD PATH
MOVE T1,[XWD .PTMAX,PTHGDP]
PATH. T1,
JFCL
; COMPENSATE FOR MONITOR...IF IMPLIED PPN USED, KILL SFDS
MOVEI T1,PT.IPP ; IMPLIED PPN?
TDNN T1,PTHGDP+.PTSWT
POPJ P,
SETZM PTHGDP+.PTPPN+1
MOVE T1,[PTHGDP+.PTPPN+1,,PTHGDP+.PTPPN+2]
BLT T1,PTHGDP+.PTMAX-1 ; ZERO OUT SFDS
POPJ P,
UPDSTA: ; [73] Check for status switch value given to set and set if so
LDB T2,[POINTR U.DEST+FURBTO,FR.STA] ; [73] PICK UP THE TYPE OF STATUS SWITCH
MOVE T3,U.DEST+FURSTA ; [73] GET STATUS VALUE GIVEN
CAMN T3,[-1] ; [73] SEE IF IT WAS SET
JRST .POPJ## ; [73] NO SO JUST CONTINUE
CAIN T2,0 ; [73] SEE IF ABSOLUTE
JRST [MOVE T1,T3 ; [73] JUST SET IT IF SO
JRST .POPJ##]
CAIN T2,1 ; [73] SEE IF WE MUST SET SOME BITS ON
JRST [OR T1,T3 ; [73] THEN DO IT
JRST .POPJ##]
ANDCAM T3,T1 ; [73] ELSE SET SOME OFF
JRST .POPJ## ; [73] Then just return
SUBTTL COPY COMMAND - COPIES FILES
$COP: ; COPY COMMAND
PUSHJ P,INIFLG ;[71]
PUSHJ P,STATIN ; INITIALIZE STATISTICS
SETZM TSTART
SETZM TENDIT ; OK, ALL STARTED
MOVX T1,%CNDTM ; GET DATE/TIME
GETTAB T1,
SETZ T1,
MOVEM T1,TSTART
JUMPLE C,.POPJ1## ; MUST HAVE VALUE
PUSHJ P,FILIN$ ; GET DESTINATION
PUSHJ P,$CLSNS
MOVEI T1,S.DEST
MOVEI T2,$FXLEN
PUSHJ P,$GTSPC ; GET SPEC
MOVE T1,S.DEST+KEYOFF
MOVEM T1,OURKEY ; SAVE OUTPUT KEY
CAIE C,"="
CAIN C,"_"
SKIPA
JRST RENSE$
PUSHJ P,SCNFIL ; GET INPUT FILE NAMES
MOVE T1,.JBFF##
MOVEM T1,SAVJFF ; SAVE JOBFF
SETCM T1,.FXNMM+S.DEST; GET NAME MASK
JUMPN T1,COPPV1 ; WILD
MOVE T1,WLDFST ; SEE IF MULTIPLE INPUT SPECS
CAMN T1,WLDLST
JRST COPPV1 ; NO, DON'T WORRY
LDB T1,[<POINTR (S.DEST+.FXMOD,FX.NUL)>]
JUMPN T1,COPPV6 ; NULL EXTENSION, WORRY
MOVE T1,.FXEXT+S.DEST; LOOK AT EXTENSION
TRC T1,-1 ; CHECK MASK
TRNE T1,-1 ; SEE IF WILD
JRST COPPV1 ; OK, DON'T WORRY
COPPV6: LDB T1,[<POINTR (S.DEST+FURBTM,FR.CTF)>]
JUMPN T1,COPPV1 ; HE MENTIONED CONCATENATION, GO ON
PUSHJ P,CHKBAT ; CHECK FOR BATCH, ASSUME CONCATENATE
JRST COPPV2
COPPV4: MOVEI T1,'COA'
MOVEI T2,[ASCIZ ./CONCATENATE being assumed.]
JSP T3,FURWARN
PUSHJ P,.TCRLF##
JRST COPPV3
COPPV2: MOVEI T1,[ASCIZ .Do you wish to concatenate the files? .]
PUSHJ P,.TSTRG##
PUSHJ P,TTYOUT
INCHRW T1
PUSHJ P,.TCRLF##
CAIE T1,"Y"
CAIN T1,"y"
JRST COPPVY
CAIE T1,"N"
CAIN T1,"n"
JRST COPPVN
CAIE T1,"H"
CAIN T1,"h"
JRST COPPVH
CAIE T1,"Q"
CAIN T1,"q"
JRST .POPJ1## ; JUST GET OUT IF DESIRED
JRST COPPV2
COPPVH: MOVEI T1,[ASCIZ /You have given multiple input files but only one output file
and there are no wildcards in the output file name. If you do not
ask for the CONCATENATE option each input file will overwrite the
previous one when it is copied to the same output file name.
Type "Y" to concatenate (copy the files end-to-end) into one
large output file. Otherwise type "N".
/]
PUSHJ P,.TSTRG##
JRST COPPV2
COPPVN: JRST COPPV1
COPPVY: JRST COPPV4
COPPV3: MOVEI T1,1 ; SET CONCATENATE
DPB T1,[<POINTR (S.DEST+FURBTO,FR.CTF)>]
DPB T1,[<POINTR (S.DEST+FURBTM,FR.CTF)>]
COPPV1: ; OK, ON WITH THE SHOW
LDB T1,[<POINTR (S.DEST+FURBTO,FR.CTF)>]
MOVEM T1,CONCTF
MOVNI T2,2
CAIN T1,1 ; SEE IF 1
MOVEM T2,CONCTF ; IF SO, MAKE -2
COPLOP:
MOVE T1,SAVJFF ; GET OLD JOBFF
SKIPG CONCTF ; IF NOT CONCATENATING,
MOVEM T1,.JBFF## ; RESTORE .JBFF TO OLD VALUE
SKIPG CONCTF
SETZM BUFHDR ; AND CLEAR BUFHDR
HLRZ T1,WLDBLK+2 ; GET SIZE OF SPEC
ADD T1,WLDPTR ; GET NEW SPEC ADDRESS
CAMGE T1,WLDFST ; AT LEAST FIRST?
MOVE T1,WLDFST ; GET FIRST
CAMLE T1,WLDLST ; MORE THAN LAST?
MOVE T1,WLDLST ; GET LAST
MOVE T1,KEYOFF(T1)
MOVEM T1,INRKEY
MOVEI T1,14 ; USE MODE 14
IFN FTDM,<
MOVE T2,CONCTF
CAME T2,[-1]
SKIPN T2
MOVEI T1,17 ; USE DUMP MODE
SKIPE INRKEY
MOVEI T1,14 ; ENCRYPTION, USE BUFFERED MODE
SKIPE OURKEY
MOVEI T1,14 ; DITTO
>
MOVEM T1,TMPMOD
SETZM LUKBLK+.RBDEV ; MAKE SURE 0 IF NOT SET
PUSHJ P,GCWILD
JRST COPDON ; END OF COPY
MOVE T1,WLDPTR
MOVE T1,KEYOFF(T1)
MOVEM T1,INRKEY
SKIPLE CONCTF
JRST CONCT1
SETZM LUKBL1
MOVE T1,[LUKBL1,,LUKBL1+1] ; ZERO RECEIVING AREA
BLT T1,LUKBL1+RIBSIZ-1
CONCT1:
SETZM PTHBLK
MOVE T1,[XWD PTHBLK,PTHBLK+1]
BLT T1,PTHBLK+.PTMAX-1
MOVE T1,[XWD .PTMAX,PTHBLK]
PATH. T1,
JFCL
SKIPLE CONCTF
JRST CONCT2
PUSHJ P,UPDBLK
JRST COPCP$
SETZ T1, ; CLEAR T1 AND USE TO ACCUMULATE RIB LENGTH
MOVE T2,U.DEST+FURSTA ; GET STATUS SWITCH VALUE IF GIVEN
CAME T2,[-1] ; SEE IF A VALUE WAS GIVEN
JRST [PUSHJ P,UPDSTA ; [73] Go set the status bits given by user
MOVEM T1,LUKBL1+.RBSTS; [73] Store user set status bits
MOVEI T1,.RBSTS ; [73] Must use at least this much of enter block
JRST .+1] ; [73] Now test author switch
MOVE T2,U.DEST+FURAUR ; [73] See if we must set author switch
CAME T2,[-1] ; [73] If -1 then not set
PUSHJ P,SETAUR ; [73] Well go see then
;;; SKIPN T1 ; [73] See if we must use a prespecified length
;;; MOVEI T1,.RBSPL ; [73] No so default to this
;;; MOVEM T1,LUKBL1+.RBCNT ; SINCE WE CAN DESTROY THINGS ACCIDENTALLY
CONCT2: SKIPE T1,LUKBLK+.RBDEV
MOVEM T1,OPNBLK+1
PUSHJ P,PRTPOP
JRST COPGOD
PUSHJ P,PRFNAM ; PRINT FILE NAME
MOVEI T1,[ASCIZ .==>.]
PUSHJ P,.TSTRG##
SKIPLE CONCTF ; CONCATENATING ON SECOND & SUCCEEDING?
JRST CONCT7 ; YES, JUST SAY THAT
MOVEI T1,OPNBL1
MOVEI T2,LUKBL1
PUSHJ P,.TOLEB## ; CALL .TOLEB
PUSHJ P,PRFWSZ ; PRINT FILE SIZE TO BE COPIED
CONCT8: MOVX T1,%CNDTM
GETTAB T1,
SETZ T1,
MOVEM T1,TENDIT ; SAVE TEMPORARY ENDING TIME
PUSHJ P,YESNO
JRST COPDL8 ; DONE, DON'T STOP TIME AGAIN
JRST [PUSHJ P,TIMFIX
JRST COPLOP]
PUSHJ P,TIMFIX
JRST COPGOD ; GO ON
CONCT7: PUSHJ P,PRFWSZ ; PRINT FILE SIZE
MOVEI T1,[ASCIZ . (concatenate to same output file) .]
PUSHJ P,.TSTRG##
JRST CONCT8
; NOW WE DO THE COPY
COPGOD:
SKIPLE CONCTF
JRST CONCT3
IFN FTDM,<
LDB T1,[POINT 4,OPNBLK,35]
CAIE T1,17
>
INBUF 0,^D33 ; SETUP INPUT BUFFERS
MOVEI T1,BUFHD1
HRLZM T1,OPNBL1+2
MOVX T1,14!UU.IBC ; USE BINARY MODE
; AND INHIBIT BUFFER CLEAR
IORM T1,OPNBL1
IFN FTDM,<
LDB T1,[POINT 4,OPNBLK,35]
IORM T1,OPNBL1 ; IF DUMP MODE INPUT, DUMP MODE OUTPUT
>
OPEN 1,OPNBL1
JRST E$$OPN
IFN FTDM,<
LDB T1,[POINT 4,OPNBL1,35]
CAIE T1,17
>
OUTBUF 1,^D33
LDB T1,[POINT 4,LUKBLK+.RBPRV,12]
IOR T1,[SETSTS 1,]
XCT T1
MOVE T1,LUKBLK+.RBALC
SKIPN LUKBL1+.RBEST
MOVEM T1,LUKBL1+.RBEST
COPRBV: ;; MOVE T1,LUKBLK+.RBVER
;; THESE LINES TAKEN OUT BECAUSE UPDBLK TAKES CARE OF IT
; SKIPN LUKBL1+.RBVER
; MOVEM T1,LUKBL1+.RBVER
MOVE T1,U.DEST+FURBTO
TXNE T1,FR.NFP
JRST SKPNF2
LDB T1,[POINT 9,.RBPRV+LUKBLK,8]
LDB T2,[POINT 9,.RBPRV+LUKBL1,8]
SKIPN T2
DPB T1,[POINT 9,.RBPRV+LUKBL1,8]
LDB T1,[POINT 23,.RBPRV+LUKBLK,35]
DPB T1,[POINT 23,.RBPRV+LUKBL1,35]
MOVE T1,.RBSTS+LUKBL1 ; FURTHER RESTRICT IF COPY
TXZ T1,RP.LOG!RP.UCE!RP.UWE!RP.URE!RP.NDL!RP.CMP!RP.FCE!RP.FWE!RP.FRE!RP.BFA!RP.CRH!RP.BDA
HLRZ T2,.RBEXT+LUKBL1 ; GET EXTENSION
CAIE T2,'UFD' ; IS IT A DIRECTORY FILE?
CAIN T2,'SFD'
CAIA ; THEN RP.ABC CAN STAY
TXZ T1,RP.ABC ; OTHERWISE IT GOES
PUSHJ P,UPDSTA ; [73] Go set status bits if given
MOVEM T1,.RBSTS+LUKBL1
MOVE T1,.RBPOS+LUKBLK
MOVEM T1,.RBPOS+LUKBL1
; MOVE T1,.RBSPL+LUKBLK
; MOVEM T1,.RBSPL+LUKBL1
; MOVE T1,.RBFT1+LUKBLK
; MOVEM T1,.RBFT1+LUKBL1
; MOVE T1,.RBNCA+LUKBLK
; MOVEM T1,.RBNCA+LUKBL1
; MOVE T1,.RBMTA+LUKBLK
; MOVEM T1,.RBMTA+LUKBL1
; MOVE T1,[.RBQTF+LUKBLK,,.RBQTF+LUKBL1]
; BLT T1,LUKBL1+.RBAUT
SETZM LUKBL1+.RBUSD
; MOVE T1,LUKBLK+.RBPCA
; MOVEM T1,LUKBL1+.RBPCA
HRRZ T1,LUKBLK+.RBEXT
HRRM T1,LUKBL1+.RBEXT
SKPNF2: ENTER 1,LUKBL1
JRST ENT1ER
HRRE T1,LUKBLK+.RBSTS ; GET STATUS
; OF OLD FILE SINCE NEW FILE
; MAY HAVE THIS INFO WIPED
; OUT BY THE ENTER
JUMPL T1,COPDA4 ; IF DIRECTORY, NO DATA
IFE FTDM,<
SETSTS 1,14 ; CHANGE MODE TO 14
>
IFN FTDM,<
LDB T1,[POINT 4,OPNBL1,35]
SETSTS 1,(T1)
CAIN T1,17 ; DUMP MODE?
JRST DMCOP1 ; YES, DO IT BY DUMP MODE
>
SETOM OURECN
SOS OURECN ; DUMMY OUTPUT WILL COME FIRST
PUSHJ P,WRTMOR ; DO OUTPUT
JRST BLTERR ; OH WELL
SUBTTL DATA COPYING
CONCT3:
SETOM INRECN ; ZERO RECORD NUMBER
; IF WE CAN, JUST BLT THE BUFFERS
PUSHJ P,REDMOR ; READ
JRST DOBLT1 ; SOMETHING NEW
MOVE T1,BUFHDR+2 ; GET INPUT BYTE COUNT
CAMLE T1,BUFHD1+2 ; IS IT LESS THAN OR EQUAL TO OUTPUT BYTE COUNT?
JRST DOCOPW ; NO, COPY BY WORDS
; DON'T DO THE BLT ON A CONCATENATE!
MOVE T1,CONCTF
JUMPE T1,CONCT6
AOJE T1,CONCT6 ; IF NOT CONCATENATE, GO AHEAD
JRST DOCOPW ; OTHERWISE WORD BY WORD COPY
CONCT6:
SETSTS 1,1B31!14 ; SHIFT OUTPUT TO USER WORD COUNT
BLTLOP: MOVE T1,BUFHDR+2 ; GET INPUT WORD COUNT
HRRZ T2,BUFHD1
HRRM T1,1(T2) ; DEPOSIT USER WORD COUNT
PUSHJ P,ADDWDS
MOVEI T2,2(T2)
ADDI T1,-1(T2) ; GET END OF BLT ADDRESS
HRL T2,BUFHDR ; GET START OF BLT ADDRESS
ADD T2,[XWD 2,0] ; AND POINT TO FIRST DATA WORD
DOBLT: BLT T2,(T1) ; MOVE THE BUFFER
PUSHJ P,WRTMOR ; WRITE THE BUFFER
JRST BLTERR ; ERROR
PUSHJ P,REDMOR ; GET A NEW BUFFER TO READ
JRST DOBLT1
JRST BLTLOP ; GO AGAIN
DOBLT1: ; HERE WHEN ABNORMAL RETURN FROM REDMOR
JUMPE T1,BLTEOF ; EOF
; JRST BLTERR ; ERROR
BLTERR: CLOSE 1,CL.RST
CLOSE 0,CL.ACS
JRST COPCP$
BLTEOF: MOVN T1,CONCTF
JUMPL T1,CONCT4
CAIN T1,2
JRST CONCT4
HRRZ T2,BUFHD1
HLLZS 1(T2) ; MAKE SURE USER COUNT IS ZERO
CLOSE 1,
CONCT4: CLOSE 0,CL.ACS
JRST COPLP4
; HERE WE COPY THE DATA
DOCOPW:
COPDAT: PUSHJ P,REDW
JRST CPODA1
PUSHJ P,WRTW
JRST COPDA2
PUSHJ P,ADDONE ; KEEP COUNT
JRST COPDAT
CPODA1: ; HERE AFTER COPYING BY WORDS--MAKE UP NUMBLK
MOVE T2,NUMWDS
MOVE T3,NUMWDS+1 ; COULD BE A DMOVE
LSHC T2,-7 ; CONVERT TO BLOCKS
MOVEM T3,NUMBLK ; SAVE NUMBER BLOCKS
MOVE T2,NUMWDS+1
TRNE T2,177 ; SEE IF WE NEED TO ROUND UP
AOS NUMBLK ; YES
; FALL INTO COPDA1 WITHOUT TOUCHING T1
COPDA1: JUMPE T1,COPDA3 ; EVERYTHING IS OK
CLOSE 1,CL.RST ; RESTORE EVERYTHING
JRST COPCP$ ; CANNOT DO IT DUE TO ERROR
COPDA2: JRST COPCP$
COPDA3:
PUSHJ P,LASOBK
COPDA4: MOVN T1,CONCTF
JUMPL T1,.+3
CAIE T1,2
CLOSE 1, ; NOT EITHER -2 OR +1 CASE
CLOSE 0,CL.ACS
JRST COPLP4
ENT1ER: PUSHJ P,EXCBLK
PUSHJ P,ENTFAIL
JFCL
PUSHJ P,EXCBLK
JRST COPLOP
COPCP$: MOVEI T1,'CCF'
MOVEI T2,[ASCIZ .Cannot COPY file(s).]
JSP T3,FURWARN
JFCL
PUSHJ P,.TCRLF##
JRST COPLOP
COPLP4:
PUSHJ P,ADDFIL
MOVN T1,CONCTF
CAIE T1,2 ; -2?
JRST COPLOP
MOVEI T1,1
MOVEM T1,CONCTF
JRST COPLOP ; IF SO, GET READY FOR SECOND TIME AROUND
SUBTTL OUTPUT COPY STATISTICS
COPDON: MOVE T1,CONCTF
JUMPE T1,CONCT5
CAMN T1,[-1]
JRST CONCT5
SOJN T1,CONCT5
CLOSE 1, ; IF CONCATENATING, CLOSE OUTPUT FILE
HRRZ T1,BUFHD1
HLLZS 1(T1)
CLOSE 1,
CONCT5: SKIPN T1,NUMFIL ; SEE HOW MANY
JRST .POPJ1## ; NONE, FORGET IT
MOVX T2,%CNDTM
GETTAB T2,
SETZ T2,
MOVEM T2,TENDIT ; ENDING TIME
COPDL8:
PUSHJ P,STATOU ; PRINT OUT STATISTICS
SKIPN PRTSUM
JRST COPDLF
MOVEI T1,[ASCIZ . Copied.]
PUSHJ P,.TSTRG##
MOVE T2,TENDIT ; GET END TIME
SUB T2,TSTART ; GET ELAPSED TIME
CAIG T2,^D10 ; SEE IF ENOUGH TIME TO WORRY ABOUT
JRST COPDLF ; NO
PUSHJ P,.PSH4T##
MOVEI T1,[ASCIZ ., Transfer rate = .]
PUSHJ P,.TSTRG##
PUSHJ P,.POP4T##
MOV2 T3,NUMWDS ; GET WORDS GONE
DIV T3,T2 ; DIVIDE TO GET WORDS PER 1/3 SEC.
LSH T3,^D10
IDIVI T3,^D9375 ; MAGIC NUMBER
MOVE T1,T3
PUSHJ P,.TDECW##
MOVEI T1,[ASCIZ . Kbaud.]
PUSHJ P,.TSTRG##
COPDLF: PUSHJ P,STATFI
JRST .POPJ1## ; OK
TIMFIX: ; FIX UP TIME FOR ANSWERS TO YES, NO QUESTIONS
MOVX T1,%CNDTM
GETTAB T1,
SETZ T1,
SUB T1,TENDIT
ADDM T1,TSTART ; FUDGE START TIME
SETZM TENDIT
POPJ P, ; AND RETURN
SUBTTL DATA TRANSFER OPERATIONS
REDW: ; READ A WORD FROM FILE
; NON-SKIP IF END OF FILE (T1=0) OR ERROR (T1 NEQ 0)
; SKIP IF WORD OK IN T1
SOSGE BUFHDR+2 ; SEE IF ANY THERE
JRST [PUSHJ P,REDMORE
POPJ P, ; ERROR
JRST REDW]
ILDB T1,BUFHDR+1 ; YES, FETCH
JRST .POPJ1##
REDMORE: ; GET NEXT BUFFER OR WHATEVER
IN
JRST REDENC ; GOT SOME. TRY AGAIN
STATZ 0,IO.ERR ; ANY ERROR BITS
JRST [PUSHJ P,.PSH4T##
GETSTS 0,T2
PUSHJ P,DOIOERR
PUSHJ P,.POP4T##
POPJ P,]
SETZ T1, ; GET T1 TO BE 0
STATZ 0,IO.EOF ; END OF FILE
POPJ P, ; THAT'S WHAT I WAS HOPING
JRST REDENC
REDENC: ; CHECK FOR ENCRYPTION
AOS INRECN
SKIPN INRKEY
JRST .POPJ1##
PUSHJ P,SAVACS
MOVE 6,INRECN ; GET BLOCK NUMBER
MOVE 5,INRKEY ; GET KEY
HRRZ 7,BUFHDR ;ADDR OF BUFFER
ADD 7,[XWD -200,2]
PUSHJ P,CRYPT.##
PUSHJ P,RESACS
JRST .POPJ1## ; READ NEXT WORD
SUBTTL DATA WRITING ON CHANNEL 1
WRTW: SOSGE BUFHD1+2 ; IS THERE ANOTHER WORD IN THE
; CURRENT BUFFER?
JRST [PUSHJ P,WRTMOR
POPJ P, ; ERROR
JRST WRTW]
IDPB T1,BUFHD1+1
JRST .POPJ1 ; SKIP-SUCCESS RETURN.
WRTMOR: AOSL OURECN
PUSHJ P,WRTENC
OUT 1,
JRST .POPJ1## ; GO SOME, TRY AGAIN
STATZ 1,IO.ERR ; ANY ERROR BITS?
JRST [PUSHJ P,.PSH4T##
PUSHJ P,EXCBLK
GETSTS 1,T2
PUSHJ P,DOIOERR
PUSHJ P,EXCBLK
PUSHJ P,.POP4T##
POPJ P,]
POPJ P,
WRTENC: SKIPN OURKEY
POPJ P,
PUSHJ P,SAVACS
MOVE 5,OURKEY
MOVE 6,OURECN
HRRZ 7,BUFHD1
ADD 7,[XWD -200,2]
PUSHJ P,CRYPT.##
PUSHJ P,RESACS
POPJ P,
LASOBK: AOS OURECN
PJRST WRTENC
SUBTTL DUMP MODE COPY ROUTINES
DMCOP1: ; DUMP MODE COPY TO BE DONE
MOVE T1,LUKBLK+.RBSIZ ; GET FILE SIZE IN WORDS
JUMPE T1,DMCOP2 ; ZERO! THAT'S EASY.
PUSHJ P,ALDMBF ; ALLOCATE BUFFERS
JRST COPCP$ ; BOO.
; HERE WITH START OF AREA IN T1, SIZE IN T2
DMCOP3: MOVNS T2 ; GET NEGATIVE SIZE
ADDM T2,LUKBLK+.RBSIZ
HRLZ T3,T2 ; PUT IN LH FOR IOWD
MOVNS T2 ; GET POSITIVE AGAIN
HRRI T3,-1(T1) ; GET RH FOR START-1
SETZ T4, ; HAVE DUMP-MODE IOWD
IN T3 ; IN IT COMES
JRST DMCOP4 ; OK
GETSTS T2
PUSHJ P,DOIOERR
PUSHJ P,RSDMBF
JRST BLTERR
DMCOP4: OUT 1,T3 ; COPY TO OUTPUT FILE
JRST DMCOP5
PUSHJ P,EXCBLK
GETSTS 1,T2
PUSHJ P,DOIOERR
PUSHJ P,EXCBLK
PUSHJ P,RSDMBF
JRST BLTERR
DMCOP5:
EXCH T1,T2
PUSHJ P,ADDWDS
EXCH T2,T1
CAMLE T2,LUKBLK+.RBSIZ
MOVE T2,LUKBLK+.RBSIZ
JUMPN T2,DMCOP3
PUSHJ P,RSDMBF
DMCOP2: ; HERE WHEN DONE
CLOSE 0,CL.ACS
CLOSE 1,
PUSHJ P,ADDFIL ; ADD ONE TO FILE COUNT
JRST COPLOP
SUBTTL DATA TRANSMISSION ERROR
DOIOERR: ; HERE IF WE HAVE AN IO ERROR
PUSH P,T2 ; SAVE GETSTS BITS
MOVEI T1,'IOE'
MOVEI T2,[ASCIZ .File input/output error for .]
PJSP T3,FURWARN
PUSHJ P,PRFNAM ; PRINT FILE NAME
MOVEI T1,[ASCIZ . - .]
PUSHJ P,.TSTRG##
POP P,T2
MOVEI T1,0
TXNE T2,IO.IMP
MOVEI T1,[ASCIZ .Improper Mode.]
TXNE T2,IO.BKT
MOVEI T1,[ASCIZ .Block too large.]
TXNE T2,IO.DER
MOVEI T1,[ASCIZ .Device error.]
TXNE T2,IO.DTE
MOVEI T1,[ASCIZ .Data error.]
JUMPE T1,DOIOE1 ; IF CAN'T FIND ANYTHING, GIVE UP
PUSHJ P,.TSTRG##
DOIOE1: PUSHJ P,.TCRLF##
SETO T1, ; SHOW ERROR NOT EOF
POPJ P, ; GIVE NON-SKIP ERROR OR EOF RETURN
SUBTTL LOOKUP/ENTER ERRORS
LUKFAIL: ; LOOKUP FAILURE FROM LUKBLK. PRINT MESSAGE
MOVEI T1,'LUF'
MOVEI T2,[ASCIZ .LOOKUP failure for .]
JSP T3,FURWARN
JRST ERRJOIN
RENFAI: ; RENAME FAIL
MOVEI T1,'RNF'
MOVEI T2,[ASCIZ .RENAME failure for .]
JSP T3,FURWARN
JRST ERRJOIN
ENTFAIL: ; ENTER FAIL
MOVEI T1,'ENF'
MOVEI T2,[ASCIZ .ENTER failure for .]
JSP T3,FURWARN
ERRJOIN:
TXNN T1,JWW.FL ; SEE IF PRINTING THE MESSAGE
PJRST .TCRLF##
PUSH P,T1
PUSHJ P,PRFNAM ; TYPE NAME
POP P,T1
REPEAT 0,<
TXNN T1,JWW.CN ; SEE IF CONTINUATION LINE
PJRST .TCRLF##
; [64] Code removed here for talkative error
; [64] messages as part of maxcore edit
> ; [64] End of code removed
PUSHJ P,.TSPAC## ; SPACE IF CONTINUED.
LDB T1,[POINT 15,LUKBLK+.RBEXT,35]
; GET ERROR CODE
CAILE T1,ERLOH% ; HIGHEST KNOWN ERROR AT THIS TIME
JRST PERNUM ; IF NOT KNOWN, JUST ERROR NUMBER
CAIN T1,ERPRT% ; DO SPECIAL FOR PROTECTION FAILURE
JRST PROTER
MOVE T1,FERMSG(T1) ; GET MESSAGE
PUSHJ P,.TSTRG##
PJRST .TCRLF## ; AND EXIT
PERNUM: MOVEI T1,[ASCIZ .Error code = .]
PUSHJ P,.TDECW##
PJRST .TCRLF##
PROTER: MOVEI T1,[ASCIZ .Protection failure .]
PUSHJ P,.TSTRG##
LDB T1,[POINT 9,LUKBLK+.RBPRV,8]
PJUMPE T1,.TCRLF## ; DON'T KNOW CODE
PUSHJ P,PRTPRT
PJRST .TCRLF
FERMSG: [ASCIZ .File not found.]
[ASCIZ .Incorrect PPN.]
[ASCIZ .Protection failure.]
[ASCIZ .File being modified.]
[ASCIZ .File already exists (if a COPY command, /ERSUPERSEDE is set).]
[ASCIZ .Illegal UUO sequence.]
[ASCIZ .Transmission error.]
[ASCIZ .Not a SAVE file.]
[ASCIZ .Not enough core.]
[ASCIZ .Device not available.]
[ASCIZ .No such device.]
[ASCIZ .Illegal UUO.]
[ASCIZ .No room.]
[ASCIZ .Write-locked.]
[ASCIZ .Not enough table space.]
[ASCIZ .Partial allocation.]
[ASCIZ .Block not free at specified position.]
[ASCIZ .Can't supersede a directory.]
[ASCIZ .Can't delete non-empty directory.]
[ASCIZ .SFD not found.]
[ASCIZ .Search list is empty.]
[ASCIZ .SFDs nested too deeply.]
[ASCIZ .No create is on for all file structures.]
[ASCIZ .Segment not on swapping space.]
[ASCIZ .Can't update file.]
[ASCIZ .Low seg overlaps high seg.]
$DDT: HRRZ T1,.JBDDT## ; SEE IF LOADED WTH DDT
JUMPE T1,E$$NDL
PUSHJ P,(T1) ; AND GO TO IT
JRST .POPJ1## ; RETURN WITH NO STORE
GOBAK:: POPJ P, ; GOBAK RETURN
E$$NDL: MOVEI T1,'NDL'
MOVEI T2,[ASCIZ .No DDT loaded.]
PJSP T3,FURERR
$QUIT: PUSHJ P,.MONRT## ; GIVE UP.
JRST .POPJ1##
SUBTTL ERASE ROUTINE
COMMENT 
WILL ERASE A MAGNETIC TAPE BY USING TU-70 DATA SECURITY ERASE.
WILL ERASE A DISK FILE BY WRITING IT TO ZERO.

$ERS:
JUMPLE C,.POPJ1## ; MUST HAVE VALUE
PUSHJ P,INIFLG ;[71]
SETOM DODELE ;[71]
PUSHJ P,STATIN ; INITIALIZE STATS
PUSHJ P,SCNFIL ; GET FILE NAMES
SETZM DODELE ;[71]
ERSLOP: MOVEI T1,17 ; USE DUMP MODE
MOVEM T1,TMPMOD
PUSHJ P,GCWILD
JRST ERSTOT ; EXIT WHEN DONE
SETZ T1, ; FIND OUT WHAT KIND OF DEVICE
DEVCHR T1,
TXNN T1,DV.DSK
JRST ERSDN1
PUSHJ P,PRTPOP
JRST ERSGO
PUSHJ P,PRFNMB ; PRINT FILE NAME AND NUMBER OF BLOCKS
PUSHJ P,YESNO ; GET ANSWER
JRST ERSTOT
JRST ERSLOP ; IF NO, THE GOAGAIN
ERSGO:
ENTER LUKBLK
JRST [PUSHJ P,ENTFAIL
JRST ERSLOP]
MOVE T1,LUKBLK+.RBSIZ ; GET FILE SIZE
JUMPE T1,ERSNO6 ; NO ERASURE NEEDED IF EMPTY
PUSHJ P,ALDMBF ; ALLOCATE DUMP-MODE BUFFER
JRST ERSLOP ; COULD NOT
SETZM (T1) ; CLEAR IT OUT
ADDI T3,-1(T1) ; GET ENDING ADDRESS
HRLZ T4,T1
HRRI T4,1(T1)
CAIE T2,1 ; DON'T BLT IF ONLY ONE WORD
BLT T4,T3 ; ZEROED OUT
ERSNO4: MOVNS T2 ; GET SIZE
ADDM T2,LUKBLK+.RBSIZ
HRLZ T3,T2 ; PUT IN LH FOR IOWD
MOVNS T2 ; MAKE POSITIVE AGAIN
HRRI T3,-1(T1) ; GET RH FOR START-1
SETZ T4, ; HAVE DUMP-MODE IOWD
OUT T3 ; THERE IT GOES
JRST ERSNO5 ; EVERYTHING OK
GETSTS T2
PUSHJ P,DOIOERR
PUSHJ P,RSDMBF
JRST ERSLOP
ERSNO5:
CAMLE T2,LUKBLK+.RBSIZ
MOVE T2,LUKBLK+.RBSIZ
JUMPN T2,ERSNO4
PUSHJ P,RSDMBF
ERSNO6: PUSH P,LUKBLK+.RBNAM
SETZM LUKBLK+.RBNAM
RENAME LUKBLK
JRST [POP P,LUKBLK+.RBNAM
PUSHJ P,RENFAIL
JRST ERSLOP]
POP P,LUKBLK+.RBNAM
MOVE T1,LUKBLK+.RBALC
LSH T1,^D7
PUSHJ P,ADDWDS
PUSHJ P,ADDFIL
JRST ERSLOP
ERSTOT: PUSHJ P,STATOU ; STATISTICS OUT
MOVEI T1,[ASCIZ . Erased.]
SKIPE PRTSUM
PUSHJ P,.TSTRG##
PUSHJ P,STATFI
JRST .POPJ1##
ERSDN1: TXNE T1,DV.MTA
JRST ERSDN2
MOVEI T1,'FKH'
MOVEI T2,[ASCIZ .FUR only knows how to erase disk files and magnetic tapes.]
PJSP T3,FURERR
PUSHJ P,.TCRLF##
JRST ERSLOP
ERSDN2: MOVE T1,[XWD 2,[EXP .TFDSE,0]]
TAPOP. T1,
JRST ERSDN3
MOVE T1,[XWD 2,[EXP .TFREW,0]]
TAPOP. T1,
JRST ERSDN3
MOVE T1,[XWD 2,[EXP .TFWLE,0]]
TAPOP. T1,
JRST ERSDN3
MOVE T1,[XWD 2,[EXP .TFREW,0]]
TAPOP. T1,
JRST ERSDN3
MOVE T1,[XWD 2,[EXP .TFSTS,0]]
TAPOP. T1,
JRST ERSDN3
TXNE T1,TF.WLK ; SEE IF TAPE WAS WRITE-LOCKED
JRST ERSDN4
MOVE T1,OPNBLK+1
PUSHJ P,.TSIXN##
MOVEI T1,[ASCIZ . Erased.]
PUSHJ P,.TSTRG##
PUSHJ P,.TCRLF##
PUSHJ P,ADDFIL
JRST ERSLOP
ERSDN4:
MOVEI T1,'TWL'
MOVEI T2,[ASCIZ .Tape write locked.]
PJSP T3,FURERR
PUSHJ P,.TCRLF##
; DROP INTO ERSDN3
ERSDN3: MOVEI T1,'DSE'
MOVEI T2,[ASCIZ .Could not data security erase magnetic tape.]
PJSP T3,FURERR
PUSHJ P,.TCRLF##
JRST ERSLOP
SUBTTL FILE SCANNING ROUTINE
; THIS ROUTINE WILL SCAN A LIST OF FILE NAMES INTO
; CORE ABOUT .JBFF IN PREPARATION FOR WILD.
SCNFIL: ; START TO SET UP WILD BLOCK
MOVEI T3,0 ; ASK FOR ZERO CORE
PUSHJ P,SPACE ; RETURNED T1 IS ADDRESS
HRRZM T1,WLDFST ; STORE ADR OF FIRST FILE SPEC
MOVE T1,[WLDFST,,WLDLST]
MOVEM T1,WLDBLK
MOVSI T1,OPNBLK ; GET OPEN BLOCK
HRRI T1,LUKBLK ; AND LOOKUP BLOCK
MOVEM T1,WLDBLK+1
MOVSI T1,$FXLEN ; GET SCANNER BLOCK LENGTH
HRRI T1,RIBSIZ ; LOOKUP BLOCK LENGTH
MOVEM T1,WLDBLK+2
MOVSI T1,(1B0) ; ALL DEVICES SO NUL: WILL WORK
SKIPE DOFIND
IOR T1,[1B3] ; IF DOING FIND, FIND SYS AFTER NEW
HRRI T1,WLDPTR
SETZM WLDPTR
MOVEM T1,WLDBLK+3
PUSHJ P,$CLSNS ; CLEAR STICKY DEFAULTS AND CONTINUE
GFILOP: ; GET FILE LOOP
JUMPLE C,GFILD ; IF TERMINATOR, DONE
PUSHJ P,FILIN$ ; GET FILE
PUSHJ P,ALLSPC
PUSHJ P,$GTSPC
SKIPN DOFIND ; IF DOING FIND, FIND IT
SKIPN .FXNMM(T1) ; IF NAME SPECIFIED BUT NOT EXTENSION
JRST GFILO2 ;[71]
MOVX T2,FX.NUL ; NULL EXTENSION
TDNE T2,.FXMOD(T1) ; IF ON, PRETEND NOT ON
IFE FT$ISM,< ; [73] Add isam dump command
HLLOS .FXEXT(T1)
> ;END OF IFE FT$ISM
IFN FT$ISM,< ; [73] Add isam dump command
PUSHJ P,GFILD3 ; [73] Do defaulting for extension
> ;END OF IFN FT$ISM
ANDCAM T2,.FXMOD(T1) ; DOESN'T HAPPEN
GFILO1: JUMPLE C,GFILD ;[71]
CAIE C,"+"
CAIN C,","
JRST GFILOP ; IF VALID SEPARATOR, GET ANOTHER FILE
CAIE C,.CHNOT ;[33]
CAIN C,.CHAND ;[33]
JRST GFILOP ;[33]
CAIN C,.CHOR ;[33]
JRST GFILOP ;[33]
MOVEI T1,'IVS'
MOVEI T2,[ASCIZ .Invalid separator.]
PJSP T3,FURERR
GFILD: MOVE T1,.JBFF##
SUBI T1,$FXLEN
HRRZM T1,WLDLST
MOVE T2,FURBTO(T1) ; GET BITS ON LAST GUY
ANDX T2,FR.MOV ; USE ONLY MOVEABLE BITS
GFILD1: SUBI T1,$FXLEN
CAMGE T1,WLDFST ; STILL GOING?
JRST GFILD2 ; NOPE
IORM T2,FURBTM(T1) ; ADD IT TO WHAT THEY SAID
IORM T2,FURBTO(T1)
JRST GFILD1
GFILD2:
IORM T2,S.DEST+FURBTM
IORM T2,S.DEST+FURBTO
PJRST GCINIT ; PREPARE TO INITIALIZE GCWILD
GFILO2: ; HERE WHEN NAME PART COMPLETELY WILD [71]
SKIPN DODELE ;[71] IF DOING DELETE, DON'T ACCEPT NULL ANYTHING
JRST GFILO1 ;[71] OK IF NOT DISASTROUS
MOVX T2,FX.NUL ;[71] NULL EXTENSION?
TDNN T2,.FXMOD(T1) ;[71] CHECK IT OUT
JRST GFILO1 ;[71] NO, EXTENSION GIVEN. LEAVE IT.
;[71] HERE IF ONLY FILESPEC IS "*"; USER MAY BE
;[71] HANGING THEMSELVES WITH "*,TMP" INSTEAD OF "*.TMP"
PUSHJ P,CHKBAT ;[71]
CAIA ;[71] WE ARE BATCH
JRST GFILO1 ;[71] ACCEPT JUST * IN BATCH
MOVE T2,FURBTO(T1) ;[71] /DECIDE:YES?
TXNE T2,FR.DEC ;[71]
JRST GFILO1 ;[71] OK, LET IT GO IF /DECIDE:YES
MOVE T2,.FXDEV(T1) ; [75] SEE IF DIRECTORY DEVICE
DEVTYP T2, ; [75]
MOVNI T2,1 ; [75] (SET DIRECTORY BIT IF UNCERTAIN)
JUMPGE T2,GFILO1 ; [75] IF TY.MAN OFF, NOT DIRECTORY DEVICE SO OK
E$$OSG: MOVEI T1,'OSG' ;[71] GIVE FUROSG ERROR
MOVEI T2,[ASCIZ /Please write *.* if you want all files/];[71]
PJSP T3,FURERR ;[71] "ONE STAR GIVEN"
INIFLG: ;ZERO DOFIND AND DODELETE FLAGS ;[71]
SETZM DODELE ;[71]
SETZM DOFIND ;[71]
SETZM DODUMP ;[73][71]
POPJ P,
IFN FT$ISM,< ; [73] Add isam dump command
GFILD3: ; [73] Here to do default extension checking
SKIPN DODUMP ; [73] Are we doing a DUMP
JRST GFILD4 ; [73] No so continue as always
MOVEI T3,'IDX' ; [73] Yes we are so default to IDX extension
HRLOM T3,.FXEXT(T1) ; [73] Deposit it in scan block
JRST .POPJ## ; [73] Then return
GFILD4: HLLOS .FXEXT(T1) ; [73] Default to anything
JRST .POPJ## ; [73] And return
> ;END OF IFN FT$ISM
SUBTTL CORE ROUTINES
ALLSPC: ; ALLOCATES $FXLEN AT .JBFF. RETURNS THAT IN T1
MOVEI T3,$FXLEN ; INCLUDE SPACE FOR CRYPT KEY
SPACE: ; ENTER WITH T3=LENGTH OF AREA TO GET. RESULT IN T1
MOVE T1,.JBFF##
MOVEI T2,(T1);
ADD T2,T3
MOVEM T2,.JBFF##
SOS T2
CAMG T2,.JBREL## ;ENOUGH ROOM?
JRST ALLSP1 ; YES
CORE T2, ; NO, TRY TO GET IT
JRST E$$NEC ; BUT CAN'T
ALLSP1: MOVE T2,T3
POPJ P, ; AMOUNT ALLOCATED IN T2 & T3
E$$NEC: MOVEI T1,'NEC'
MOVEI T2,[ASCIZ .Not enough core.]
PJSP T3,FURERR
RESCOR: MOVE T1,INICOR ; RESTORE INITIAL CORE
HLRZM T1,.JBFF## ; RESTORE .JBFF#
TLZ T1,-1 ; CLEAR OUT
CAME T1,.JBREL## ; SEE IF SAME AS NOW
CORE T1, ; IF NOT,
JFCL ; RELEASE IT
POPJ P, ; RETURN
SUBTTL ROUTINES TO ALLOCATE DUMP-MODE BUFFERS IN CORE
ALDMBF: ; ALLOCATE A DUMP-MODE BUFFER SUFFICIENT FOR THE NUMBER
; OF WORDS IN T1
; IF CAN'T GET IT ALL WITHOUT GOING OVER THE PHYSICAL LIMIT,
; ALLOCATE SOME AMOUNT WHICH WILL ALLOW 640-WORD CHUNKS
; (WHICH IS ONE CLUSTER AT NIH; PERHAPS HALF A CLUSTER ELSEWHERE)
SKIPE T2,CPPL ; SEE IF WE KNOW CPPL
JRST ALDMB4 ; YES, DON'T NEED TO FIND OUT AGAIN
MOVX T3,%NSCMX ; GET CORMAX
GETTAB T3,
JRST ALDMBE ; TOO BAD
MOVEM T3,CPPL ; SAVE IT
HRROI T3,.GTCVL ; FIND CURRENT PHYSICAL LIMIT OR GUIDELINE
GETTAB T3,
JRST ALDMB5 ; MUST BE NON-VM
TRZ T3,400000 ; TURN OFF GUIDELINE BIT
HRRZS T3 ; GET RID OF VIRTUAL LIMIT
JUMPE T3,ALDMB5 ; IF ZERO, IGNORE IT
LSH T3,^D9 ; SHIFT TO MAKE ADDRESS
CAMGE T3,CPPL ; SEE IF LESS
MOVEM T3,CPPL ; YES, SAVE NEW ONE
ALDMB5: HRROI T3,.GTLIM ; GET CORE LIMIT THIS WAY
GETTAB T3,
JRST ALDMB6 ; CAN'T GET IT!
LSH T3,-^D<36-10>
JUMPE T3,ALDMB6 ; NOT IN EFFECT IF ZERO
LSH T3,^D9
CAMGE T3,CPPL
MOVEM T3,CPPL
ALDMB6: MOVE T3,CPPL
SKIPN T2,S.MXCR ; [64] SEE IF WE HAVE BEEN GIVEN A SPECIFIC VALUE
JRST [MOVEI T2,AD.MXC ; [64] GET DEFAULT MAXCOR VALUE
MOVEM T2,S.MXCR ; [64] AND STORE FOR LATER
JRST .+1] ; [64] AND CONTINUE
CAMLE T3,T2 ; [64] SEE WHICH IS THE LESSOR
MOVE T3,T2 ; [64] AND SAVE IT
MOVEM T3,CPPL ; [64] FOR USE LATER
SUBI T3,1000 ; SUBTRACT SIZE OF UPMP
MOVEI T2,HSGAD ;[74] GET KNOWN HIGH SEGMENT ORIGIN
HLRZ T4,.JBHRL## ;[74] GET SIZE OF HIGH SEG
SKIPN T4 ;[74] IF ZERO, NO HIGH SEG
MOVSI T2,1 ;[74] SO LOW SEG CAN EXPAND TO ALL 18 BITS
SUB T3,T4 ;[74] MAX POSSIBLE CORE ARGUMENT
CAMLE T2,T3 ; SEE WHICH IS TIGHTER LIMIT
MOVE T2,T3 ; TIGHTER LIMIT IN T2
MOVEM T2,CPPL ; AND SAVE TIGHTER LIMIT
ALDMB4:
JUMPL T2,E$$ICB ; IF NO SPACE THEN ERROR
MOVE T3,.JBFF##
ADD T3,T1 ; SEE WHAT FITS
CAML T3,T2 ; DOES IT FIT?
JRST ALDMB2 ; NO
; OK, CAN DO WITH NO ALTERATIONS
MOVE T3,T1 ; PUT SIZE IN T3
JRST ALDMB3
ALDMB2: ; HERE CAUSE IT DIDN'T FIT
SUB T2,.JBFF## ; SEE HOW MUCH SPACE THERE IS
IDIVI T2,^D640 ; BY CLUSTERS APPROXIMATELY
IMULI T2,^D640 ; AND USE THIS SIZE
JUMPE T2,[MOVEI T3,200
JRST ALDMB3]; IF ONE-BLOCK BITS ARE ALL THAT'S AVAILABLE, USE IT
MOVE T3,T1 ; GET REQUESTED SIZE
ADD T3,T2
SUBI T3,1
IDIV T3,T2 ; COMPUTE NUMBER OF PASSES REQUIRED
MOVE T2,T1 ; GET SIZE AGAIN
ADD T2,T3
SUBI T2,1
IDIV T2,T3 ; COMPUTE SIZE NEEDED PER PASS
ADDI T2,^D639 ; ROUND UP TO CLUSTER SIZE
IDIVI T2,^D640 ; FIND HOW MANY CLUSTERS
IMULI T2,^D640 ; AND BACK TO NEEDED SIZE
MOVE T3,T2 ; PUT IN RIGHT REGISTER FOR SPACE
ALDMB3: PUSHJ P,SPACE ; GET THE SPACE
; PLACE IS IN T1, SIZE IN T2 & T3
MOVEM T1,DMAADD ; AND REMEMBER WHERE IT WAS
JRST .POPJ1## ; SUCCESS RETURN
RSDMBF: ; RELEASE DUMP-MODE BUFFER (IF ANY)
HRRZ T1,DMAADD
MOVEM T1,.JBFF## ; RESTORE .JBFF##
IORI T1,777 ; ROUND UP TO PAGE BOUNDARY
CAME T1,.JBREL## ; SEE IF SAME AS NOW
CORE T1, ; AND GET CORE IF NEEDED
JFCL
POPJ P,
ALDMBE: MOVEI T1,'CNE'
MOVEI T2,[ASCIZ .Cannot erase .]
JSP T3,FURWARN
PJRST ERRJOIN
E$$ICB: MOVEI T1,'ICB' ; GIVE BIG ERROR !
MOVEI T2,[ASCIZ \Insufficient core for buffer requirements Increase MAXCORE.\]
PJSP T3,FURERR
SUBTTL GET MAXIMUM CORE SIZE FOR MAXCOR SWITCH
GETMAX: PUSHJ P,.COREW## ; [64] GET VALUE FROM SCAN (IN WORDS)
CAIGE N,^D256 ; [64] IF THEY SAID LESS THAN 256 ASSUME THEY MEAN 'K'
SKIPE T1 ; [64] AND THERE WAS NO SUFFIX
SKIPA
IMULI N,^D1024 ; [64] TURN INTO 'K' IF THAT HAPPENS
MOVEI T1,MAXCOR ; [64] GET DEFAULT MAXIMUM CORE SIZE
CAMLE N,T1 ; [64] SEE IF USER ASKED FOR MORE THAN DEFAULT
SKIPA T2,.MYPPN## ; [64] YES SO GO CHECK IF HE'S PRIVILEDGED
JRST GETMA3 ; [64] AND GO EXIT
GETMA2: HLRZ T2,T2 ; [64] CUT DOWN TO JUST THE PROJECT
CAIE T2,1 ; [64] IS PROJECT = 1
CAIN T2,PRVPRJ ; [64] OR = THE OTHER PRIVED PROJECT SELECT ABOVE
JRST GETMA3 ; [64] YES SO IT IS OK
MOVEI N,AD.MXC ; [64] GET REGULAR DEFAULT
MOVEI T1,'NEP' ; [64] NOT ENOUGHT PRIVS TO EXCEED MAXCORE DEFAULT
MOVEI T2,[ASCIZ .Not enough privileges to exceed default MAXCORE of .]
PJSP T3,FURWARN ; [64] ISSUE MESSAGE
MOVEI T1,MAXCOR ; [64] GET DEFAULT MAXIMUM
PUSHJ P,.TCORW## ; [64] TYPE OUT AS CORE ARGUMENT
PUSHJ P,.TCRLF## ; [64] GIVE (CR-LF) SEQUENCE
GETMA3: MOVEM N,S.MXCR ; [64] AND SAVE IT FOR LATER
SETZM CPPL ; [64] FORCE RECOMPILATION OF MAXCORE AVAILABLE
POPJ P, ; [64] AND RETURN
GETSTA: PUSHJ P,.TIAUC## ; PRIME THE PUMP
SETZ T1, ; CLEAR T1 BEFORE GETING FLAG BIT VALUE
CAIN C,"+" ; SEE IF MASKED BIT (SET)
MOVEI T1,1 ; IF YES SET FLAG BITS TO 1
CAIN C,"-" ; SEE IF MASKED BITS (NOT SET)
MOVEI T1,2 ; IF YES ET FLAG BITS TO 2
DPB T1,[POINT 2,FRFBTF,10]
; PUT INTO FLAG WORD
CAIGE C,"0" ; SEE IF WE HAVE A NUMBER
MOVEI C,"0" ; IF NOT ERASE THE + OR - IN C BEFORE CALL
PUSHJ P,.OCTNC## ; TO .OCTNC TO READ SWITCH VALUE
MOVEM N,STAUSF ; AND REMEMBER IT FOR LATER
POPJ P, ; THEN RETURN TO SCAN
GETAUR: ; [73] GET AUTHOR PPN
PUSHJ P,.TIAUC##
CAIE C,"[" ; [73] PPN MUST START THIS WAY
CAIN C,"<" ; [73] OR THIS WAY
SKIPA
JRST E$$LBD ; [73] GIVE AN ERROR OTHER WISE
PUSHJ P,.TIAUC## ; [73] GET NEXT CHARACTER
CAIN C,"-" ; [73] SEE IF PATH PPN WANTED
JRST DEFPTH ; [73] IF SO SET DEFAULT PATH PPN
SETZB N,T2 ; [73] CLEAR AC'S USED
PUSHJ P,$NUMC ; [73] IF NOT "-" GO GET NUMBER
CAIE C,"," ; [73] SHOULD BE "," OR AN ERROR
JRST E$$CRD ; [73] GIVE AN ERROR
CAILE N,-1 ; [73] [777777,0] IS MAX PROJECT NUMBER
JRST E$$IPJ ; [73] GIVE ERROR
SKIPN N ; [73] IF 0 USE LOGGED IN PROJECT
HLRZ N,.MYPPN##
HRLM N,AUTHRF ; [73] STORE PROJECT NUMBER
HRLM T2,AUTHRM ; [73] AND PROJECT MASK
SETZB T2,N ; [73] CLEAR ACS AGAIN
PUSHJ P,$NUMW ; [73] AND GET PROGRAMMER NUMBER
CAIE C,"]" ; [73] SHOULD END WITH THIS
CAIN C,">" ; [73] OR THIS
SKIPA
JRST E$$RBD ; [73] GIVE AN ERROR
CAILE N,-1 ; [73] [0,777777] IS MAXIMUM PROGRAMMER NUMBER
JRST E$$IPG ; [73] GIVE ERROR
SKIPN N ; [73] IF 0 USE LOGGED-IN PROGRAMMER
HRRZ N,.MYPPN##
HRRM N,AUTHRF ; [73] STORE PROGRAMMER NUMBER
HRRM T2,AUTHRM ; [73] AND IT'S MASK
PUSHJ P,.TIAUC## ; [73] GET NEXT CHARACTER FOR SCAN
JRST .POPJ1 ; [73] AND RETURN TO SCAN
DEFPTH: SETZM PTHBLK ; [73] CLEAR OUT PATH BLOCK
MOVE T1,[XWD PTHBLK,PTHBLK+1]
BLT T1,PTHBLK+.PTMAX-1
MOVE T1,[XWD .PTMAX,PTHBLK]
SETOM PTHBLK ; [73] PUT IN FUNCTION CODE
PATH. T1, ; [73] GET THE PATH
JFCL ; [73] IF WE CAN'T WE CAN'T
MOVE T1,PTHBLK+.PTPPN ; [73] GET THE PPN
MOVEM T1,AUTHRF ; [73] STORE FOR LATER
SETZM AUTHRM ; [73] AND IT'S MASK
PUSHJ P,.TIAUC## ; [73] GET NEXT CHARACTER
CAIE C,"]" ; [73] SHOULD END WITH THIS
CAIN C,">" ; [73] OR THIS
SKIPA
JRST E$$RBD ; [73] GIVE AN ERROR
PUSHJ P,.TIAUC## ; [73] GET NEXT CHARACTER FOR SCAN
JRST .POPJ1 ; [73] AND RETURN TO SCAN
$NUMW: PUSHJ P,.TIAUC## ; [73] GET CHARACTER IF NOT ALREADY IN "C"
$NUMC: CAIE C,"*" ; [73] LOOK FOR FULL WILD-CARD
JRST NUMST ; [73] NO--GO GET NAME
TRO N,777777 ; [73] PUT IN SUITABLE NUMBER
MOVEI T2,0 ; [73] SET WILD MASK
PJRST .TIAUC## ; [73] GO GET ANOTHER CHARACTER
NUMST: SKIPA T2,[-1] ; [73] INITIALIZE TO FULL MASK
NUMNU: PUSHJ P,.TIAUC## ; [73] YES--GET NEXT DIGIT
CAIE C,"?" ; [73] SEE IF WILD CARD
JRST NUMNU1 ; [73] NO--STUFF
LSH T2,3 ; [73] YES--GET 0 INTO MASK
LSH N,3 ; [73] UPDATE NAME
TRO N,7 ; [73] FORCE NAME NON-ZERO
JRST NUMNU ; [73] LOOP BACK FOR MORE
NUMNU1: CAIL C,"0" ; [73] SEE IF OCTAL
CAILE C,"7"
POPJ P, ; [73] RETURN WITH N=NUMBER T2=MASK
ROT T2,3 ; [73] ADVANCE MASK
TRO T2,7 ; [73] FORCE THE BITS ON
LSH N,3 ; [73] ADVANCE ACCUMULATOR
ADDI N,-"0"(C) ; [73] ADD IN THIS DIGIT
JRST NUMNU ; [73] AND LOOP BACK FOR MORE
E$$LBD: MOVEI T1,'LBD' ; [73] GIVE PREFIX
MOVEI T2,[ASCIZ .Left bracket required on AUTHOR.]
PJSP T3,FURERR
E$$RBD: MOVEI T1,'RBD' ; [73] GIVE PREFIX
MOVEI T2,[ASCIZ .Right bracket required on AUTHOR.]
PJSP T3,FURERR
E$$CRD: MOVEI T1,'CRD' ; [73] GIVE PREFIX
MOVEI T2,[ASCIZ .Comma required in directory for AUTHOR.]
PJSP T3,FURERR
E$$IPJ: MOVEI T1,'IPJ' ; [73] GIVE PREFIX
MOVEI T2,[ASCIZ .Incorrect format for Project number in AUTHOR.]
PJSP T3,FURERR
E$$IPG: MOVEI T1,'IPG' ; [73] GIVE PREFIX
MOVEI T2,[ASCIZ .Incorrect format for Programmer number in AUTHOR.]
PJSP T3,FURERR
SUBTTL ROUTINE TO SUB FOR .FILIN
; AND CLEAR THE CRYPTING KEY WHEN CALLED
FILIN$: SETZM CRYPTK
SETZM FRFBTM
SETZM FRFBTF ; TEMPORARY BITS ARE RENEWED EACH TIME
SETOM STAUSF ; CLEAR THE STATUS VALUE
SETOM SPLNMF
SETOM AUTHRF ; CLEAR THE AUTHOR SWITCH
SETZM AUTHRM ; AND MASK
PJRST .FILIN##
SUBTTL APPLY OUR DEFAULTS TO FILE SPEC
$GTSPC: ; CALL GTSPC BUT ALSO STORE ENCRYPTION KEY AND OTHER SUNDRIES
; PRESERVE T1
PUSH P,T2 ; SAVE LENGTH
MOVE T2,CRYPTK
MOVEM T2,KEYOFF(T1) ; SAVE IT
MOVE T2,FRQBTF ; GET PERMANENT BITS
ANDCM T2,FRFBTM ; BUT ERASE THOSE NEWLY SPECIFIED
IOR T2,FRFBTF ; AND ADD THEIR REAL VALUES
MOVEM T2,FURBTO(T1) ; STORE AWAY
MOVE T2,FRFBTM ; NEW MASK IS COMBO
IOR T2,FRQBTM
MOVEM T2,FURBTM(T1) ; OF OLD AND NEW
MOVE T2,SPLNMF ; SPECIFIED A SPOOLED NAME?
CAMN T2,[-1]
MOVE T2,SPLNMQ ; PERHAPS BEFORE THE SOMETHING?
MOVEM T2,FURSPL(T1)
MOVE T2,STAUSF ; SPECIFIED A NEW STATUS?
CAMN T2,[-1]
MOVE T2,STAUSQ ; WELL MAYBE BEFORE
MOVEM T2,FURSTA(T1) ; PUT IT AWAY
MOVE T2,AUTHRF ; SEE IF GAVE AN AUTHOR
CAMN T2,[-1] ; NO WELL
MOVE T2,AUTHRQ ; MAYBE BEFORE?
MOVEM T2,FURAUR(T1) ; SAVE IT
MOVE T2,AUTHRM ; GET IT'S MASK
CAMN T2,[0] ; SEE IF GAVE A NEW ONE
MOVE T2,AUTHMQ ; NO WELL MAYBER BEFORE
MOVEM T2,FURAUM(T1) ; STORE IT AWAY
POP P,T2
SOS T2 ; SAVE SO REAL .GTSPC WON'T WIPE IT OUT
PUSH P,T1 ; SAVE START
PUSHJ P,.GTSPC## ; GET REAL SPEC
POP P,T1 ; GET START BACK
SKIPN DOFIND ; IF DOING FIND, DON'T FIXUP SYS
SKIPN CANSTD ; IF NO STD: DEVICE AVAILABLE, DON'T FIXUP
JRST NOSTDF ; NO FIXUP
PUSH P,T2
MOVE T2,.FXDEV(T1) ; GET DEVICE
CAMN T2,[SIXBIT /SYS/]
MOVSI T2,(SIXBIT /STD/)
MOVEM T2,.FXDEV(T1)
POP P,T2
NOSTDF:
POPJ P, ; RETURN
SUBTTL ROUTINE TO REPLACE .CLSNS
$CLSNS: ; CLEAR DEVICE AND OTHER DEFAULTS
MOVE T1,FRPBTF ; GET CURRENT PERMANENT DEFAULTS
MOVEM T1,FRQBTF ; AND SAVE THEM FOR THIS LINE
MOVE T1,FRPBTM ; SAME WITH MASK
MOVEM T1,FRQBTM
MOVE T1,STAUSP ; GET CURRENT PERM DEFAULT
MOVEM T1,STAUSQ ; AND REMEMBER
MOVE T1,SPLNMP
MOVEM T1,SPLNMQ
MOVE T1,AUTHRP ; GET PERM AUTHOR DEFAULT
MOVEM T1,AUTHRQ ; AND REMEMBER
PJRST .CLSNS## ; AND NOW CALL REAL CLSNS ROUTINE
SUBTTL MEMORIZE STICKY SWITCHES (PRIMARILY FOR OSCAN)
STKMEM::; MAKE OUR SWITCHES STICKY
; DON'T MAKE ENCRYPTION KEYS STICKY
MOVE T1,FRFBTM ; SEE WHICH BITS SPECIFIED
ANDCAM T1,FRPBTF ; AND CLEAR OUT IN PERMANENT COPY
IORM T1,FRPBTM ; WHILE TURNING THEM ON IN THE MASK
AND T1,FRFBTF ; GET NEW COPIES OF THESE BITS
IORM T1,FRPBTF ; AND INCLUDE THEM
MOVE T1,SPLNMF
CAME T1,[-1] ; SEE IF NEW SPOOL NAME
MOVEM T1,SPLNMP
MOVE T1,STAUSF ; GET STATUS VALUE
CAME T1,[-1] ; SEE IF NEW ONE
MOVEM T1,STAUSP ; MAKE STICKY
MOVE T1,AUTHRF ; SEE IF AUTHOR GIVEN
CAME T1,[-1] ; -1 IF NOT
MOVEM T1,AUTHRP ; MAKE PERM
MOVE T1,AUTHRM ; GET IT'S MASK
CAME T1,[0] ; 0 IF NOT GIVEN
MOVEM T1,AUTHMP ; REMEMBER
POPJ P,
STQMEM::; MAKE SWITCHES STICKY FOR A WHILE
MOVE T1,FRFBTM ; SEE WHICH BITS SPECIFIED
ANDCAM T1,FRQBTF ; AND CLEAR OUT IN SEMI-PERMANENT COPY
IORM T1,FRQBTM ; WHILE TURNING THEM ON IN THE MASK
AND T1,FRFBTF ; GET NEW COPIES OF THESE BITS
IORM T1,FRQBTF ; AND INLCUDE THEM
MOVE T1,SPLNMF
CAME T1,[-1]
MOVEM T1,SPLNMQ ; SAVE NEW SPOOL NAME
MOVE T1,STAUSF
CAME T1,[-1] ; SEE IF NEW STATUS SWITCH
MOVEM T1,STAUSQ ; IF SO MAKE STICKY
MOVE T1,AUTHRF ; GET AUTHOR SWITCH
CAME T1,[-1] ; -1 IF NOT GIVEN
MOVEM T1,AUTHRQ ; MAKE SEMI-STICKY
MOVE T1,AUTHRM ; AND IT'S MASK
CAME T1,[0] ; 0 IF NOT SET
MOVEM T1,AUTHMQ ; MAKE SEMI-STICKY
POPJ P,
SUBTTL INTERFACE TO ENCRYPTION ROUTINES
GETKEY: ; CALLED FROM SWITCH SCANNER WHEN THE RESULT IS
; TO SCAN IN AN ASCII KEY AND REDUCE IT TO A SEED
PUSHJ P,.ASCQW## ; GET ASCII POSSIBLY QUOTED STRING
JFCL ; UNSURE ABOUT RETURNS
PUSHJ P,SAVACS
MOVEI 7,.NMUL## ; GET POINTER TO VALUE
PUSHJ P,CRASZ.## ; AND REDUCE TO A SEED
; BY CALLING ENDECR
PUSH P,5 ; VALUE OF SEED TO STORE
PUSHJ P,RESACS ; PUT BACK ACS
POP P,N ; GET BACK VALUE TO STORE
POPJ P,
SAVACS: MOVEM 7,SAVACB+7
MOVEI 7,SAVACB
BLT 7,SAVACB+7-1
MOVE 7,SAVACB+7
POPJ P,
RESACS: MOVSI 7,SAVACB
BLT 7,7
POPJ P,
SUBTTL ROUTINE TO REPLACE .LKWLD AND AVOID %NO SUCH DIRECTORIES BUG
GCWILD: ; GET AND CHECK FOR WILD; SKIP IF WILD
GCWLD3:
SETZM LUKBLK
SKIPE GCWCAW ; SEE IF WE SHOULD CALL WILD IMMEDIATELY
JRST GCWLD4
SETZM OPNBLK
SKIPN T1,GCWPTR
SKIPA T1,GCWFST ; MUST BE FIRST SPEC NEEDED
ADDI T1,$FXLEN ; GET NEXT SPEC
CAMLE T1,GCWLST ; BEYOND END?
POPJ P, ; YES, ALL DONE
PUSHJ P,CHKWLD ; SEE IF WILD
JRST GCWLD1 ; NOT WILD
MOVEM T1,WLDFST ; COULD BE FIRST SPEC FOR REAL WILD
GCWLD5: LDB T2,[POINTR (.FXMOD(T1),FX.TRM)] ; GET TERMINATOR
CAML T1,GCWLST ; ARE THERE MORE SPECS?
JRST GCWLD6 ; NO
ADDI T1,$FXLEN ; LOOK AT NEXT SPEC
JUMPN T2,GCWLD5 ; NEXT SPEC IF AUTOMATICALLY WILD IF
; PREVIOUS HAD NON-ZERO ENDING CODE
PUSHJ P,CHKWLD ; SEE IF NEXT ONE IS WILD TOO
CAIA
JRST GCWLD5 ; YES, INCLUDE IT TOO
SUBI T1,$FXLEN ; PUT THINGS BACK
GCWLD6: MOVEM T1,WLDLST ; LAST WILD SPEC
SETZM WLDPTR ; INDICATE FIRST CALL TO WILD
MOVEM T1,GCWPTR ; REMEMBER GCWPTR
GCWLD4: MOVE T1,[4,,WLDBLK]
PUSHJ P,.LKWLD## ; CALL LOOKUP-WILD
JRST [SETZM GCWCAW ; DON'T CALL WILD DIRECTLY ANYMORE
JRST GCWLD3] ; AND LOOK FOR ANOTHER SPEC
PUSHJ P,DOOLK
JRST GCWLD4 ; FAILED, TRY ANOTHER FILE
PUSHJ P,.CHKTM## ; CHECK DATE/TIME CRITERIA IN WILD
JRST GCWLD4 ; FAILED, TRY ANOTHER FILE
MOVE T1,WLDPTR
MOVE T1,FURSPL(T1)
CAMN T1,[-1]
MOVE T1,LUKBLK+.RBSPL
CAME T1,LUKBLK+.RBSPL
JRST GCWLD4 ; FAILED, TRY ANOTHER FILE
PUSHJ P,CHKSTA ; GO CHECK FOR STATUS VALUES
JRST GCWLD4 ; FAILED SO TRY ANOTHER FILE
PUSHJ P,CHKAUT ; GO SEE IF AUTHOR MATCHES
JRST GCWLD4 ; NO TRY AGAIN
SETOM GCWCAW ; CALL WILD NEXT TIME
GCWXIT: MOVE T1,WLDPTR ; GET WILD POINTER TO THIS FILE
LDB T2,[<POINTR (FURBTO(T1),FR.DEC)>]
MOVEM T2,$DECID ; AND REMEMBER IT FOR PEOPLE
LDB T2,[<POINTR (FURBTO(T1),FR.ADC)>]
IORM T2,$DECID ; MIGHT HAVE /ALLDECIDE
LDB T2,[<POINTR (FURBTO(T1),FR.BEQ)>]
MOVEM T2,$QUIET
LDB T2,[<POINTR (FURBTO(T1),FR.ABQ)>]
IORM T2,$QUIET
JRST .POPJ1## ; SUCCEEDED, USE IT
GCWLD1: MOVEM T1,GCWPTR ; STORE NEW POINTER
MOVEM T1,WLDPTR ; STORE FOR COPLOP
MOVEM T1,WLDFST
SETZM GCWCAW ; DON'T CALL WILD NEXT TIME
HRLI T1,$FXLEN ; GET LENGTH
MOVEI T2,OPNBLK
MOVE T3,[XWD RIBSIZ-1,LUKBLK]
MOVEI T4,PTHBLK
PUSHJ P,.STOPB## ; FIXUP LOOKUP/ENTER BLOCK
HALT .+1 ; IT WAS WILD??????
PUSHJ P,CHKNLK ; NEED LOOKUP?
SKIPL T1,TMPMOD ; CALLER WANT LOOKUP?
CAIA ; YES, ONE OF THE TWO
JRST GCWXIT ; NEITHER, RETURN
PUSHJ P,DOOLK ; DO OPEN AND LOOKUP
JRST GCWLD3 ; FAILED, TRY ANOTHER FILE
PUSHJ P,CHKTM ; CHECK DATE/TIME CRITERIA
JRST GCWLD2 ; FAILED
JRST GCWXIT ; SUCCEEDED
GCINIT: ; PREPARE TO CALL GCWILD
MOVE T1,WLDFST
MOVEM T1,GCWFST
MOVE T1,WLDLST
MOVEM T1,GCWLST
SETZM GCWCAW
SETZM GCWPTR
POPJ P,
GCWLD2: MOVEI T1,'FDF'
MOVEI T2,[ASCIZ .File does not fit criteria - .]
JSP T3,FURWARN
TXNN T1,JWW.FL
PJRST .TCRLF##
PUSHJ P,PRFNAM ; PRINT FILE NAME
PUSHJ P,.TCRLF##
JRST GCWLD3
CHKSTA: ; CHECK FOR DIFFERING STATUS SWITCH OPTIONS GIVE SKIP RETURN IF SUCCESSFUL
MOVE T1,WLDPTR ; POINT TO CURRENT FILE
LDB T2,[<POINTR (FURBTO(T1),FR.STA)>]
; GET STATUS SWITCH TYPE
MOVE T1,FURSTA(T1) ; GET STATUS SWITCH VALUE
CAMN T1,[-1] ; IF -1 IT WAS NOT SET
JRST .POPJ1## ; SO GIVE SKIP RETURN
CAIN T2,0 ; SEE IF ABSOLUTE CHECKING
JRST CHKABS ; YES GO CHECK VALUE
CAIN T2,1 ; SEE IF JUST TEST FOR CERTAIN BITS ON
JRST CHKSET ; YES GO CHECK IF THEY ARE ALL SET
; IF WE DROP THRU WE ARE CHECKING FOR BITS NOT SET
CKNSET: MOVE T2,LUKBLK+.RBSTS; GET THE FILES STATUS WORD
TDNE T2,T1 ; CHECK FOR MASKED BITS ALL NOT ON
JRST .POPJ## ; WE FAILED
JRST .POPJ1## ; ALL MASKED BITS NOT ON SO GIVE SKIP RETURN
CHKABS: CAME T1,LUKBLK+.RBSTS; SEE IF FILE STATUS = GIVEN STATUS
JRST .POPJ## ; NO WE FAILED
JRST .POPJ1## ; YES GIVE SKIP RETURN
CHKSET: MOVE T2,LUKBLK+.RBSTS; GET FILE STATUS BITS
TDNN T2,T1 ; SEE IF ANY OR ALL BITS WERE SET ON
JRST .POPJ## ; NO WE HAVE FAILED
JRST .POPJ1## ; YES THEY WERE GIVE SKIP RETURN
CHKAUT: ; [73] CHECK FOR WILDCARDED AUTHOR SWITCH
MOVE T1,WLDPTR ; [73] POINT TO CURRENT FILESPEC
MOVE T2,FURAUR(T1) ; [73] GET AUTHOR SWITCH IF GIVEN
CAMN T2,[-1] ; [73] IF -1 THEN NOT GIVEN
JRST .POPJ1## ; [73] NOT GIVEN GIVE SKIP RETURN
SKIPN FURAUM(T1) ; [73] SEE IF MASK IS 0 NO WILDCARDS
JRST [CAMN T2,LUKBLK+.RBAUT ; [73] CHECK FOR EXACT MATCH IF NOT WILD
JRST .POPJ1##; [73] YES SO GO BACK SKIP RETURN
JRST .POPJ##]; [73] NO IT FAILED WE LOSE
XOR T2,LUKBLK+.RBAUT; [73] SEE IF WE WIN OR LOSE
TDNN T2,FURAUM(T1) ; [73] CHECK AGAINST MASK
JRST .POPJ1## ; [73] WE WIN!!
JRST .POPJ## ; [73] WE LOSE AGH!
SUBTTL OPEN A FILE
DOOLK: ; DO OPEN AND LOOKUP USING OPNBLK AND LUKBLK
MOVE T1,TMPMOD ; GET TEMPORARY MODE
IORM T1,OPNBLK
MOVEI T1,RIBSIZ-1
IORM T1,LUKBLK ; SET LOOKUP SIZE
MOVEI T1,BUFHDR ; USE OUR BUFFER HEADER
MOVEM T1,OPNBLK+2 ; SINCE WILD CLOBBERED ONE THERE BEFORE
SKIPL T1,BUFHDR ; GET POINTER TO BUFFER RING IF VIRGIN
SETZ T1, ; OTHERWISE ZERO
OPEN OPNBLK
JRST E$$OPN
MOVEM T1,BUFHDR ; AND KEEP IT AROUND
SETZM LUKBLK+.RBSIZ
SETZM LUKBLK+.RBALC ; ZERO OUT SIZE AND ALLOCATION
MOVE T1,LUKBLK+.RBPPN ; SAVE RBPPN WORD
LOOKUP LUKBLK
JRST [EXCH T1,LUKBLK+.RBPPN
MOVEM T1,ORGDIR
PJRST LUKFAIL] ; LOOKUP FAILED
EXCH T1,LUKBLK+.RBPPN ; RESTORE IT
MOVEM T1,ORGDIR ; SAVE OLD VALUE
JRST .POPJ1##
SUBTTL CHKTM
; CHECK DATE/TIME/LENGTH CRITERIA FOR SCAN
; NON-CONCATENATED FILES
CHKTM: ; OPEN AND LOOKUP BLOCKS SET UP
; WLDPTR POINTS TO FILE SPEC
PUSHJ P,.SAVE1## ; SAVE P1
MOVE P1,WLDPTR ; POINT TO SPEC
SKIPGE .FXBFR(P1) ; SEE IF /BEFORE GIVEN
SKIPL .FXSNC(P1) ; SEE IF /AFTER GIVEN
PUSHJ P,CHKTM1 ; CHECK CREATION DATE/TIME
CAIA ; OK
POPJ P, ; FAIL
SKIPGE .FXABF(P1) ; SEE IF /ABEFORE GIVEN
SKIPL .FXASN(P1) ; SEE IF /SINCE GIVEN
PUSHJ P,CHKTM2 ; CHECK ACCESS DATE
CAIA ; OK
POPJ P, ; FAIL
SKIPGE .FXFLM(P1) ; SEE IF MAXIMUM LENGTH
SKIPL .FXFLI(P1) ; SEE IF MINIMUM LENGTH
PUSHJ P,CHKTM3
CAIA ; OK
POPJ P, ; FAILED
MOVE T1,FURSPL(P1)
CAMN T1,[-1]
MOVE T1,LUKBLK+.RBSPL
CAME T1,LUKBLK+.RBSPL
POPJ P, ; FAILED
JRST .POPJ1## ; SUCCEEDED
CHKTM1: MOVE T2,.RBPRV+LUKBLK ; FIND CREATION DATE
LDB T3,[POINTR (.RBEXT+LUKBLK,RB.CRX)]
LSH T3,WID(RB.CRD) ; GET EXTENSION OF CREATION DATE
LDB T1,[POINTR (T2,RB.CRT)]
IMULI T1,^D60000 ; CONVERT TO MILLISECONDS
ANDI T2,RB.CRD ; MASK DATE
ADD T2,T3 ; COMBINE WITH DATE EXTENSION
PUSHJ P,.CNVDT## ; CONVERT TO INTERNAL FORMAT
SKIPLE .FXBFR(P1) ; SEE IF /BEFORE GIVEN
CAMG T1,.FXBFR(P1) ; YES, COMPARE
CAMGE T1,.FXSNC(P1) ; TRY SINCE
JRST .POPJ1## ; FAILED ONE OF THE TESTS
POPJ P, ; SUCCEEDED
CHKTM2:
MOVE T2,.RBEXT+LUKBLK;GET ACCESS DATE
ANDX T2,RB.ACD ; REMOVE JUNK
MOVEI T1,0 ; CLEAR TIME
PUSHJ P,.CNVDT## ; CONVERT
SKIPLE .FXABF(P1) ; SEE IF /ABEFORE
CAMG T1,.FXABF(P1) ; IF SO, COMPARE
CAMGE T1,.FXASN(P1) ; CHECK /SINCE
JRST .POPJ1## ; FAILED TEST
POPJ P, ; SUCCEEDED
CHKTM3: SKIPGE T1,LUKBLK+.RBSIZ; GET SIZE
POPJ P, ; NO SIZE, MUST BE OK
SKIPL .FXFLM(P1) ; SEE IF MAXIMUM NEEDED
CAMG T1,.FXFLM(P1) ; YES, DOES IT PASS?
CAMGE T1,.FXFLI(P1) ; CHECK AGAINST MINIMUM
JRST .POPJ1## ; SUCCEEDED
POPJ P, ; FAILED
CHKNLK: ; SEE IF WE NEED A LOOKUP ON THIS FILE BEFORE TESTING
; NON-SKIP RETURN IF YES
MOVE T1,WLDPTR
SKIPGE .FXBFR(T1)
SKIPL .FXSNC(T1)
JRST .POPJ1##
SKIPGE .FXABF(T1)
SKIPL .FXSNC(T1)
JRST .POPJ1##
SKIPGE .FXFLM(T1)
SKIPL .FXSNC(T1)
JRST .POPJ1##
MOVE T1,FURSPL(T1)
CAME T1,[-1]
JRST .POPJ1## ; NEEDED
POPJ P, ; NOT NEEDED
SUBTTL CHECK TO SEE IF SCAN SPEC IS WILD (AND WE CAN CALL STOPB)
CHKWLD: ; CALL HERE WITH ADDRESS OF SPEC IN T1
; USES T2-T3
LDB T2,[POINTR (.FXMOD(T1),FX.TRM)] ; GET TERMINATOR
JUMPN T2,.POPJ1## ; YES, WILD ENOUGH TO CALL WILD
LDB T2,[POINTR (.FXMOD(T1),FX.STR)] ; SEE IF /STRS
JUMPN T2,.POPJ1## ; YES, CALL WILD
;;;; SKIPE T2,.FXNAM(T1) ; GET NAME
SETCM T2,.FXNMM(T1) ; GET NAME MASK
JUMPN T2,.POPJ1## ; WILD
;;;; SKIPE T2,.FXEXT(T1) ; GET EXTENSION
MOVE T2,.FXEXT(T1) ; GET EXTENSION
TRC T2,-1 ; CHECK MASK
TRNE T2,-1 ; SEE IF WILD
JRST .POPJ1## ; YES
MOVX T2,FX.DIR ; SEE IF DIRECTORY
TDNN T2,.FXMOD(T1) ; SEE IF SET
JRST CHKWL2
SETCM T2,.FXDIM(T1) ; GET UFD MASK
JUMPN T2,.POPJ1## ; SEE IF WILD
MOVEI T3,.FXDIR+2(T1) ; POINT TO DIRECTORY
HRLI T3,-<.FXLND-1> ; COUNT SFDS
CHKWL1: SKIPN T2,(T3) ; SEE IF NAME THERE
JRST CHKWL2
SETCM T2,1(T3)
JUMPN T2,.POPJ1## ; WILD
AOJ T3,
AOBJN T3,CHKWL1
CHKWL2: POPJ P, ; NOT WILD
SUBTTL SEE IF SHOULD PRINT PROPOSED OPERATION
PRTPOP: ; PRINT PROPOSED OPERATION?
SKIPG $DECIDE ; IF DECIDE IS ON, YES, DO PRINT
SKIPG $QUIET ; USER WANT QUIET?
AOS 0(P) ; SKIP RETURN IF TO PRINT
POPJ P, ; OTHERWISE NON-SKIP
PRFNAM: ; PRINT FILE NAME
MOVEI T1,OPNBLK
MOVEI T2,LUKBLK
;; PJRST MYTOLB ; DO MY VERSION OF TOLEB
MYTOLB: ; SAME AS .TOLEB## EXCEPT IT FIXES UP DEVICE NAMES FOR NEW, SYSTEM, OLD
IFN FT$MAI,< ;[72] ADD TEST FOR MAIL PPN
MOVE T3,.RBPPN(T2) ;[72] LOOK AT PPN
CAMN T3,MAIPPN ;[72] SEE IF IT IS THE MAIL AREA
JRST .TOMAI ;[72] AND IF SO TYPE AS PPN
> ;END OF IFN FT$MAI
SKIPE T3,.RBPPN(T2)
JRST .TOLEB##
PUSH P,1(T1)
PUSH P,T1
PUSH P,T2
HLRZ T4,1(T1) ; GET CURRENT DEVICE
MOVE T3,ORGDIR
CAIN T4,'LIB' ; IF LIB, PUT IN PPN
MOVEM T3,.RBPPN(T2) ; SAY IT
MOVE T4,1(T1) ; GET CURRENT DEVICE AGAIN
CAMN T3,[1,,4] ; SEE IF SYS (COULD HAVE ASKED FOR NEW OR OLD)
MOVSI T4,'SYS' ; TELL USER SYS
CAMN T3,[1,,5] ; SEE IF NEW (COULD HAVE ASKED FOR SYS)
MOVSI T4,'NEW' ; TELL USER NEW
MOVE T3,1(T1) ; GET ORIGINAL NAME AGAIN
ANDI T3,770000 ; PICK UP LAST LETTER OF NAME, IF THERE
TRNN T4,770000 ; DOES IT ALREADY HAVE ONE?
IOR T4,T3 ; PUT BACK ORIGINAL LETTER (IF ANY)
MOVEM T4,1(T1) ; PUT IN OPEN BLOCK
PUSHJ P,.TOLEB## ; PRINT IT
POP P,T2 ; AND GET BACK STUFF
SETZM .RBPPN(T2) ; LIKE WE FOUND IT
POP P,T1
POP P,1(T1)
POPJ P,
IFN FT$MAI,< ;[72] ADD TEST FOR THE MAIL AREA PPN
.TOMAI: MOVE T4,T2 ;[72] MAKE A SAFE COPY OF LOOKUP POINTER
MOVE T1,.OPDEV(T1) ;[72] GET DEVICE
PUSHJ P,.TSIXN## ;[72] TYPE IT
PUSHJ P,.TCOLN## ;[72] AND A COLON
MOVE T1,.RBNAM(T4) ;[72] GET FILENAME
PUSHJ P,.TPPNW## ;[72] TYPE AS A PPN
MOVEI T1,"."
PUSHJ P,.TCHAR##
HLLZ T1,.RBEXT(T4) ;[72] GET EXTENSION
PUSHJ P,.TSIXN## ;[72] AND TYPE IT
MOVEI T1,.RBPPN(T4) ;[72] POINT TO DIRECTORY
PJRST .TDIRB## ;[72] AND GO TYPE IT ADN RETURN
> ;END OF IFN FT$MAI
PRFWSZ: ; PRINT FILE SIZE IN BLOCKS FROM .RBSIZ
MOVE T1,LUKBLK+.RBSIZ
ADDI T1,177
LSH T1,-^D7
CAIA ; SKIP OVER NEXT LOAD OF T1
PRFBSZ: ; PRINT FILE SIZE IN BLOCKS FROM .RBALC
MOVE T1,LUKBLK+.RBALC
PUSH P,T1
PUSHJ P,.TSPAC##
POP P,T1
PJRST .TDECW##
PRFNMB: ; PRINT FILE NAME AND ALLOCATED SIZE IN BLOCKS
PUSHJ P,PRFNAM
PJRST PRFBSZ
PRTPRT: ; PRINT PROTECTION CODE
MOVEI T1,"<"
PUSHJ P,.TCHAR##
LDB T1,[POINT 3,LUKBLK+.RBPRV,2]
ADDI T1,"0"
PUSHJ P,.TCHAR##
LDB T1,[POINT 3,LUKBLK+.RBPRV,5]
ADDI T1,"0"
PUSHJ P,.TCHAR##
LDB T1,[POINT 3,LUKBLK+.RBPRV,8]
ADDI T1,"0"
PUSHJ P,.TCHAR##
MOVEI T1,">"
PJRST .TCHAR##
SUBTTL OUTPUT ROUTINES TO BE USED INSTEAD OF OUTCHRS
OUTONE: PUSH P,T2 ; SAVE REGISTER T2
MOVEI T2,1 ; PUT HORIZONTAL POSITION ADJUSTMENT IN T2
CAIN T1,15 ; CARRIAGE RETURN?
MOVN T2,HPOS ; BACK TO ZERO
CAIN T1,12 ; LINEFEED?
MOVEI T2,0 ; NO CHANGE
CAIN T1,11 ; TAB?
JRST [MOVE T2,HPOS
IORI T2,7
SUB T2,HPOS
AOJA T2,.+1]
; DON'T EXPECT ANYTHING ELSE SPECIAL TO COME ALONG
ADDM T2,HPOS
POP P,T2 ; GET BACK ORIGINAL T2
REOUT: SOSGE TTYBFH+2; ANY ROOM IN OUTPUT BUFFER?
JRST [PUSHJ P,TTYOUT
JRST REOUT]
IDPB T1,TTYBFH+1 ; STORE CHAR
CAIE T1,12 ; AT LINEFEED OUTPUT THE LINE
POPJ P, ; EXIT
TTYOUT::OUT TTYCHAN,
POPJ P, ; OK
HALT .-1 ; OUTPUT TO TERMINAL FAILED
TTYOPN: OPEN TTYCHAN,[EXP 0,SIXBIT .TTY.,XWD TTYBFH,0]
HALT .+1 ; COULDN'T OPEN TTY
OUTBUF TTYCHAN,1 ; GET MY ONE BUFFER
PJRST TTYOUT ; DO ONE OUT TO ESTABLISH THE BUFFER
SUBTTL STATISTICS ROUTINES
STATIN: ; INITIALIZE STATISTICS VARIABLES
SETZM NUMFIL
SETZM NUMWDS
SETZM NUMWDS+1
SETZM PRTSUM
SETZM NUMBLK
POPJ P,
ADDWDS: ; ADD NUMBER OF WORDS IN T1 TO NUMWDS
; AND KEEP A BLOCK COUNT IN NUMBLK
; DON'T CHANGE ANY REGISTERS
PUSH P,T1
ADDI T1,177 ; ROUND UP FRACTION OF A BLOCK
LSH T1,-7 ; GET RID OF LSB
ADDM T1,NUMBLK ; TALLY NUMBER OF BLOCKS
POP P,T1 ; RESTORE ORIGINAL NUMBER
CAIA ; SKIP OVER ALTERNATE ENTRANCE
ADDONE: MOVEI T1,1 ; JUST ONE WORD FROM COPY BY WORDS ROUTINE
JFCL 17,.+1 ; CLEAR ALL FLAGS
ADDM T1,NUMWDS+1
JOV [EXCH T1,NUMWDS+1
TLZ T1,(1B0) ; TURN OFF NEW SIGN BIT
EXCH T1,NUMWDS+1
AOS NUMWDS
POPJ P,]
POPJ P,
ADDFIL: ; ADD ONE TO NUMBER OF FILES
AOS NUMFIL
POPJ P,
TLBRKT: MOVEI T1,"["
SETOM PRTSUM
PJRST .TCHAR##
STATOU: ; PRINT STATISTICS FOR FILES AND BLOCKS
MOVE T1,NUMFIL
SKIPE $QUIET
JRST STATO3
CAIG T1,5
JRST STATO4
STATO3: PUSHJ P,TLBRKT
SKIPN T1,NUMFIL
JRST STATO1
PUSHJ P,.TDECW##
MOVEI T1,[ASCIZ . File.]
PUSHJ P,.TSTRG##
MOVEI T1,"s"
MOVE T2,NUMFIL
CAIE T2,1
PUSHJ P,.TCHAR##
STATO4:
SKIPN NUMBLK ; GET NUMBER OF BLOCKS
JRST STATO2
MOVEI T1,[ASCIZ ., .]
SKIPE PRTSUM
PUSHJ P,.TSTRG##
SKIPN PRTSUM
PUSHJ P,TLBRKT ; PRINT BRACKET IF NEEDED
MOVE T1,NUMBLK ; GET BLOCKS AGAIN
PUSHJ P,.TDECW##
MOVEI T1,[ASCIZ . Block.]
PUSHJ P,.TSTRG##
MOVEI T1,"s"
MOVE T2,NUMBLK
CAIE T2,1
PUSHJ P,.TCHAR##
STATO2: POPJ P,
STATO1: MOVEI T1,[ASCIZ .No files.]
PJRST .TSTRG##
STATFI: PUSHJ P,RESCOR ; AS A SIDE-AFFECT, RETURN CORE
MOVEI T1,"]" ; STATISTICS FINISH
SKIPN PRTSUM
POPJ P, ; NOTHING TO DO
PUSHJ P,.TCHAR##
PJRST .TCRLF##
END START
Reference in New Issue View Git Blame Copy Permalink