.TITLE RTR .ENABLE LC ; ; Written by:- ; ; Phil Stephensen-Payne, ; c/o Systime Ltd., ; Concourse Computer Centre, ; 432 Dewsbury Road, ; LEEDS LS11 7DF, ; England. ; .MACRO FERR,X,P1,P2,P3,P4 MOV #I'X,R1 .IIF NB , MOV P1,ARGBLK .IIF NB , MOV P2,ARGBLK+2 .IIF NB , MOV P3,ARGBLK+4 .IIF NB , MOV P4,ARGBLK+6 JMP FERR .ENDM .MACRO DIAG,X,P1,P2,P3,P4 MOV #I'X,R1 .IIF NB , MOV P1,ARGBLK .IIF NB , MOV P2,ARGBLK+2 .IIF NB , MOV P3,ARGBLK+4 .IIF NB , MOV P4,ARGBLK+6 CALL DIAG .ENDM .MCALL CSI$1,CSI$2,GCMLD$,GCML$,CLOSE$,GCMLB$,FDOP$A,FDAT$A .MCALL GTIM$S,CSI$SW,CSI$SV,CSI$ND,NMBLK$,FDRC$A,PUT$,FSRSZ$ .MCALL EXIT$S,QIOW$S,FINIT$,SPWN$,WTSE$S,DIR$ ; ; This is a File Transfer Program to copy files from a RSTS/E V6C pack ; to an RSX one. It also supports a modicum of RSTS directory listing. ; OUTLUN = 1 CMDLUN = 2 INPLUN = 3 .PAGE .SBTTL Offset Definitions ; ; This Section defines Symbolic Offsets for all the various blocks ; in the RSTS Directory Structure. ; ; MFD Label Block ; M.LID = 2 ; Label Block Identifier (-1) M.PCS = 10 ; Pack Cluster Size M.PST = 12 ; Pack Status M.PID = 14 ; Pack ID (2 words, RAD50) ; ; MFD Name Block ; M.NAM = 2 ; PPN M.PWD = 4 ; Password (2 words RAD50) M.UST = 10 ; Status Byte M.UPR = 11 ; Protection Code M.UAC = 12 ; Access Count M.UAA = 14 ; Link to Accounting Block M.UAR = 16 ; DCN of First UFD Cluster ; ; Bits in MFD/UFD Status Byte ; S.FDS = 1 ; File data space on other volume S.FOW = 4 ; File open for Write S.FOU = 10 ; File open for Update S.NEX = 20 ; File may not be extended S.NDE = 40 ; File may not be deleted S.UFD = 100 ; Entry describes a UFD S.MDL = 200 ; File is marked for deletion ; ; MFD Accounting Block ; M.CPU = 2 ; Accumulated CPU time (LSB) M.CON = 4 ; Accumulated Connect time M.KCT = 6 ; Accumulated Kilo-Core-Ticks (LSB) M.DVT = 10 ; Accumulated Device Time M.KCT2 = 12 ; Accumulated Kilo-Core-Ticks (MSB) M.CPU2 = 13 ; Accumulated CPU Time (MSB) M.DKQ = 14 ; Logout Disk Quota M.UCL = 16 ; UFD Cluster Size ; ; MFD Cluster Map Block ; M.CLS = 760 ; MFD Cluster Size M.DCN = 762 ; DCN of first MFD Cluster ; ; UFD Name Block ; U.NAM = 2 ; File Name (2 words RAD50) U.EXT = 6 ; File Extension (1 word RAD50) U.FST = 10 ; File Status Byte U.FPR = 11 ; File Protection Byte U.FAC = 12 ; File Access Count U.FAA = 14 ; Link to Accounting Block U.RIB = 16 ; Link to First RIB ; ; UFD Accounting Block ; U.DLA = 2 ; Date of Last Access U.SIZ = 4 ; Number of Blocks in File U.DCR = 6 ; Date Created U.TCR = 10 ; Time Created U.RTS = 12 ; Run-Time System Name (2 words RAD50) U.FCL = 16 ; File Cluster Size ; ; UFD Attributes Block ; U.ATT = 2 ; Start of Attribute Data ; ; UFD Retrieval Information Block (RIB) ; U.ENT = 2 ; First DCN entry in RIB ; ; UFD Cluster Map Block ; U.CLS = 760 ; UFD Cluster Size U.DCN = 762 ; DCN of first UFD Cluster .PAGE .SBTTL RTR Mainline Code ; ; This section of code governs the mainline operation of the program. ; RTR: FINIT$ ; Initialise the file section MOV SP,SAVSP ; Save Stack pointer ; RTR1: MOV SAVSP,SP ; Restore stack pointer CLR UFDPWD ; Clear the UFD password CALL GETCMD ; Get the next command from the user BIT #NMSW,SWMSK$ ; /NM specified? BEQ 3$ ; If eq no - find MFD as usual MOV #UFDPWD,R0 ; Yes - get address of UFD password CLR R1 ; Say period is terminator CALL $CAT5 ; Convert to RAD50 MOV R1,UFDPWD ; Store 1st half CLR R1 ; Set R1 again CALL $CAT5 ; Convert rest to RAD50 MOV R1,UFDPWD+2 ; and store it CLR MFDBLK ; Initialise MFD block.. MOV #1,MFDBLK+2 ; .. to 2 MOV #2,DVCLSZ ; Default the device cluster size MOV #496.,LNKBLO ; And link offset to end of block BR 5$ ; Omit MFD search ; 3$: CALL GETMFD ; Read the MFD and set up relevant values ; 5$: BIT #LISW!DISW,SWMSK$ ; Any Switches? BNE 10$ ; If ne yes - look for them CALL FILCPY ; No - copy one or more files BR RTR2 ; Get the next command ; 10$: BIT #DISW,SWMSK$ ; /DI specified? BEQ 20$ ; If eq no - check for /LI CALL LSTMFD ; Yes - list the MFD ; 20$: BIT #LISW,SWMSK$ ; /LI specified? BEQ 30$ ; If eq no - check for spool CALL LSTUFD ; Yes - list the UFDs ; 30$: BIT #FLFL,SWMSK$ ; ANYTHING GET LISTED? BEQ 40$ ; BR IF NO FILES BIT #SPSW,SWMSK$ ; SPOOL THIS FILE? BEQ RTR2 ; BR IF NO MOV #OUTFDB,R0 ; GET THE FILE DESC. BLK CALL .PRINT ; INSERT IN PRINT QUEUE BR RTR2 ; CONTINUE 40$: ; REFERENCE DIAG NOFL ; ISSUE "NO SUCH FILE" DIAGNOSTIC RTR2: CLOSE$ #OUTFDB ; --- BR RTR1 ; Get next command .PAGE .SBTTL GETMFD Read the first block of the MFD ; ; This Subroutine reads the first block of the MFD into the buffer ; area MFDBUF. It also stores the Device Cluster Size in DVCLSZ. ; GETMFD: MOV #1,R1 ; Initialise to Block 1 ; 10$: QIOW$S #IO.RLB,#INPLUN,#1,,#IOSB,,<#MFDBUF,#512.,,#0,R1> ; Read the next block TSTB IOSB ; I/O OK? BPL 15$ ; If PL Yes - carry on MOVB IOSB,R0 ; Sign-extend the error FERR READ,R0 ; No - log error ; 15$: CMP MFDBUF+M.LID,#-1 ; Is it the 1st MFD Block? BEQ 20$ ; If eq yes - carry on INC R1 ; No - try the next one CMP R1,#10. ; Tried enough times? BLE 10$ ; No - try again FERR NRSTS ; Say it's not a RSTS pack ; 20$: MOV R1,DVCLSZ ; Store the Device Cluster Size CLR MFDBLK ; Set up the MFD Buffer Block Number MOV R1,MFDBLK+2 ; MOV MFDBUF,MFDLNK ; Store the first MFD Link RETURN .PAGE .SBTTL GETCMD Get the Next Command ; ; This Routine gets the First or Next Command for the program ; ; GETCMD: CLR SWMSK$ ; Clear Options Mask CLR NXUIC$ ; ASSUME NO WILD CARD UICS GCML$ #CMDBLK ; GET COMMAND LINE BCC CMDOK ; BR=AOK CMPB #GE.EOF,G.ERR(R0) ; LOOK FOR END-OF-FILE BEQ 5$ ; BR IF EXPECTED ERROR FERR GCME ; ELSE LOG ERR 5$: EXIT$S ; THEN LEAVE ; ; COMMAND ERROR ; CS1ERR: FERR CS1E CS2IER: FERR CS2I CS2OER: FERR CS2O CMDERR: FERR GCME PARSER: FERR PRSE EXIT$S ; ; CMDOK: MOV G.CMLD+2(R0),R1 ; COMMAND START MOV G.CMLD(R0),R2 ; AND LENGTH BEQ GETCMD ; If not there, Re-Prompt CSI$1 #CSIBLK,R1,R2 ; CK SYNTAX BCS CS1ERR ; BR IF BAD MOV #SWTABL,C.SWAD(R0) ; SET SWITCH TABLE ADDRESS MOVB #CS.OUT,(R0) ; ASSUME THAT OUTPUT IS ALL THAT WAS GIVEN MOV #OUTDFN,R3 ; GET DEFAULT NAME BLOCK FOR LISTING CLR R2 ; ASSUME NO NAME FOR OUTPUT IN STRING MOV #"TI,N.DVNM(R3) ; ASSUME THAT THE "TI:" IS WHERE IT GOES CLR R4 ; Set Equals Sign flag BIT #CS.EQU*400,(R0) ; WAS AN "=" GIVEN? BEQ 30$ ; BR IF NO-ASSUMPTIONS WERE CORRECT INC R4 ; Show there was an equals sign MOV #"SY,N.DVNM(R3) ; NAME GIVEN-CHANGE DEFAULT TO "SY0:" CALL .CSI2 ; PARSE REAL OUTPUT NAME BCS CS2OER ; OUTPUT SPEC ERROR MOVB #CS.INP,(R0) ; SET UP TO DO INPUT NEXT MOV #,R2 ; GET DATA-SET-DESCRITOR ADDRESS 30$: MOV #OUTFDB,R0 ; SET FILE-DESCRIPTOR-BLOCK MOV #,R1 ; AND FILE-NAME-BLOCK FOR PARSE CALL .PARSE ; ---AND PARSE IT! BCS PARSER ; BR IF FAILED TST R4 ; An equals sign given? BEQ 35$ ; If eq no - we open the file always MOVB #R.VAR,OUTFDB+F.RTYP ; Default to Variable Length BITB #IMSW,SWMSK$ ; /IM specified? BEQ 33$ ; If EQ no - carry on MOVB #R.FIX,OUTFDB+F.RTYP ; Yes - reset to Fixed ; 33$: TST OUTFDB+F.FNB+N.FNAM ; Output File Specified? BNE 35$ ; If ne yes - Open it TST OUTFDB+F.FNB+N.FTYP ; Sure it's specified? BEQ 40$ ; If eq no - don't open it ; 35$: BIS #FOPN,SWMSK$ ; Show the file is open CALL .OPFNB ; OPEN THE FILE BCC 40$ ; BR IF A-OK FERR OPNO ; FATAL OPEN ON OUTPUT FILE 40$: MOV #CSIBLK,R0 ; SET CSI BLOCK CALL .CSI2 ; Get Input Filespec BCS CS2IER ; INPUT SPEC ERROR BITB #CS.MOR,C.STAT(R0) ; CHECK FOR INVALID SYNTAX BNE CMDERR ; BR IF THERE BIT #HESW,SWMSK$ ; Help switch? BEQ 45$ ; If EQ no - process normally DIR$ #HLSPWN ; Yes - ask for help WTSE$S #1 ; Wait for it to finish CLOSE$ #OUTFDB ; Close the output file we opened JMP GETCMD ; Get next line ; 45$: MOV #TDBUF$,R0 ; POINT AT DATE BUFFER MOV #OUTBLK,R1 ; SCRATCH AREA GTIM$S R1 ; FIND THE TIME CALL $DAT ; CONVERT DATE TO NORMAL FORM MOVB #40,(R0)+ ; SEPARATE DATE AND TIME MOV #2,R2 ; SET TO CONVERT HR,MIN CALL $TIM ; AND CONVERT THE TIME CALL .RDFUI ; Get Default UIC MOVB R1,WCUSR$ ; Store User Number SWAB R1 ; Swap them around MOVB R1,WCGRP$ ; Store the Group Number MOV C.DIRD+CSIBLK,R0 ; NOW LENGTH BEQ 90$ ; BR IF NO DIRECTORY STRING MOV C.DIRD+2+CSIBLK,R3 ; POINT AT DIRECTORY DESC. INC R3 ; SKIP [ CMPB #'*,(R3) ; IS IT WILD? BNE 60$ ; If ne no - convert the number INC NXUIC$ ; Show we've got a Wild UIC INC R3 ; Skip over '*' INC R3 ; Skip over ',' MOV #-1,R1 ; Set Group to Wild BR 70$ ; and Parse member code ; 60$: CALL CNVNUM ; Convert the number ; 70$: MOVB R1,WCGRP$ ; Store the result CMPB #'*,(R3) ; Member wild? BNE 80$ ; If NE no - convert member INC NXUIC$ ; Show we've got a wild UIC INC R3 ; Skip over '*' MOV #-1,R1 ; Set User to Wild BR 90$ ; Carry on ; 80$: CALL CNVNUM ; No - convert the number ; 90$: MOVB R1,WCUSR$ ; Store result MOV #INPFDB,R0 ; GET FDB MOV #,R1 ; FILE NAME BLOCK MOV #,R2 ; DATA SET DESCRIPTOR MOV #INPDFN,R3 ; Set up Default Filename Block CALL .PRSDV ; PARSE DEVICE BCC 100$ ; EXIT INIT IF OK FERR PRSE ; INDICATE ERROR 100$: CALL .PRSFN ; Parse the Filename BCC 110$ ; If cc OK - carry on FERR PRSE ; Else error ; 110$: RETURN ; ; CNVNUM - Local Subroutine to convert a UIC group/member to binary ; CNVNUM: MOV R3,R0 ; Get address of input CALL $CDTB ; Assume it is decimal CMPB R2,#'. ; Was it? BNE 10$ ; If NE no - convert as Octal INC R0 ; Yes - skip over . BR 20$ ; Exit ; 10$: MOV R3,R0 ; Get start address back CALL $COTB ; Convert as Octal ; 20$: MOV R0,R3 ; Reset address RETURN .PAGE .SBTTl CNVLNK Convert a Link Word ; ; This Routine converts a Link Word into its constituent ; Block Number, Cluster Number, Blockette Number, Blockette Offset ; and In Use flags. ; ; On Input:- ; R3 = Address of Link Word ; On Output:- ; LNKBLK = Block Number ; LNKCLS = Cluster Number ; LNKBLE = Blockette Number ; LNKBLO = Blockette Offset ; LNKFLG = In Use flag ; CNVLNK: MOV (R3),R1 ; Get the Link Word ASH #-12.,R1 ; Get the Block Number BIC #177760,R1 ; Clear any Sign Extension MOV R1,LNKBLK ; Store it MOV (R3),R1 ; Get the Link Word again ASH #-9.,R1 ; Wipe out Blockette Number & Flags BIC #177770,R1 ; Mask off everything we don't want MOV R1,LNKCLS ; Store the result MOV (R3),R1 ; Get the Link Word again BIC #177017,R1 ; Mask off all but Blockette Number MOV R1,LNKBLO ; Store Blockette Offset ASH #-4,R1 ; Convert to Blockette Number MOV R1,LNKBLE ; Store it MOV (R3),R1 ; Get the Link Word again BIC #177776,R1 ; Mask off all but flag bit MOV R1,LNKFLG ; Store it RETURN .PAGE .SBTTL CNVCLS Convert Cluster Number and offset to Block Number ; ; This Subroutine converts a cluster and block offset into a logical ; block number. ; ; On Input:- ; DVCLSZ - Device Cluster Size ; LNKBLK - Block Offset within Cluster ; CLSDCN - Device Cluster Number of Cluster ; ; On Output:- ; BLOCK - Logical Block (Doubleword) ; ; Note:- ; The Calculation is BLOCK = (CLSDCN*DVCLSZ) + LNKBLK ; CNVCLS: MOV CLSDCN,R0 ; Get Device Cluster Number MUL DVCLSZ,R0 ; Multiply by Device Cluster Size ADD LNKBLK,R1 ; Add the Block Offset ADC R0 ; Add in High-Order carry MOV R0,BLOCK ; Store the result MOV R1,BLOCK+2 ; RETURN .PAGE .SBTTL LSTMFD List the UFDs on the Disk ; ; This subroutine lists the UFDs on the Disk. ; ; On Input:- ; The first link word is in MFDLNK LSTMFD: MOV #IMFHD1,R1 ; Get address of Heading CALL OUTLST ; Output it MOV #IMFHD2,R1 ; And second line CALL OUTLST ; MOV #IBLANK,R1 ; And a blank line CALL OUTLST ; BIS #FLFL,SWMSK$ ; Set the Files Found bit MOV #MFDLNK,R3 ; Get address of Link Word ; 10$: CALL NXTUFD ; Get the next UFD BCS 20$ ; If CS no more - exit MOV M.NAM(R3),UFDNO ; Get the PPN CALL CNVUIC ; Convert the UIC MOV #ARGBLK,R0 ; Get address of argument list MOV #UICSTR,(R0)+ ; Get address of UIC string MOV M.PWD(R3),(R0)+ ; Store the Password MOV M.PWD+2(R3),(R0)+ ; MOV #IMFDL1,R1 ; Get Instruction String Address CALL OUTLST ; Output to Listing File BR 10$ ; Get the next UFD ; 20$: RETURN .PAGE .SBTTL GETUFD Get a UFD ; ; This routine gets the first blockette of a UFD ; ; On Input:- ; WCUSR$ = Programmer Number of UFD ; WCGRP$ = Project Number of UFD ; MFDLNK = Link to First MFD Name Block ; ; On Output:- ; R3 = Address of First Blockette ; UFDBUF contains block ; UFDLNK = First UFD link to Name Block ; GETUFD: CALL NXTUFD ; Get the next UFD BCC 20$ ; If cc OK - carry on JMP 50$ ; No - UFD not found ; 20$: CMPB WCUSR$,#-1 ; Wild User? BEQ 30$ ; If eq yes - this matches CMPB WCUSR$,M.NAM(R3) ; No - does this match? BNE GETUFD ; No - try next one ; 30$: CMPB WCGRP$,#-1 ; Wild Group? BEQ 40$ ; If eq yes - this matches CMPB WCGRP$,M.NAM+1(R3) ; No - does this match? BNE GETUFD ; No - try next one ; 40$: BIT #NMSW,SWMSK$ ; /NM specified? BEQ 43$ ; If eq no - we've checked enough CMP UFDPWD,M.PWD(R3) ; Yes - check password as well BNE GETUFD ; If ne not the same - try next blockette CMP UFDPWD+2,M.PWD+2(R3) ; Same for second half BNE GETUFD ; 43$: MOV M.NAM(R3),UFDNO ; Save the UIC MOV R3,UFDADD ; Save UFD address MOV M.UAR(R3),R3 ; Get DCN of first UFD Cluster BNE 45$ ; If ne OK - carry on MOV UFDADD,R3 ; Restore UFD address TST NXUIC$ ; Wildcard UICs? BNE GETUFD ; If ne Yes - try next one SEC ; No - Signal failure BR 50$ ; Exit ; 45$: MOV R3,R0 ; Get DCN for multiplication MUL DVCLSZ,R0 ; Multiply by Device Cluster Size MOV R0,UFDBLK ; Store the Block Number MOV R1,UFDBLK+2 ; QIOW$S #IO.RLB,#INPLUN,#1,,#IOSB,,<#UFDBUF,#512.,,R0,R1> ; Read in the First UFD Block TSTB IOSB ; I/O OK? BPL 47$ ; If PL Yes - carry on MOVB IOSB,R0 ; Sign-extend the error FERR READ,R0 ; No - log error ; 47$: MOV #UFDBUF,R3 ; Store address of first link MOV (R3),UFDLNK ; Save first link CLC ; Show success ; 50$: RETURN .PAGE .SBTTL LSTUFD List one or more UFDs ; ; This Routine Lists the Contents of one or more UFDs ; ; On Input:- ; OUTLUN is assigned to the output device ; INPFNB holds the input file specifications ; WCGRP$ holds the Group Number ; WCUSR$ holds the Member Number ; LSTUFD: CLR GTOTBL ; Clear total number of blocks.. CLR GTOTFL ; .. and total number of files CLR GTOTBL+2 ; CLR GTOTFL+2 ; MOV #MFDLNK,R3 ; Set up address of Link Word ; 5$: CALL GETUFD ; Get the next UFD BCC 7$ ; If cc OK - carry on JMP 50$ ; Omit listing ; 7$: CLR UTOTBL ; Clear total number of blocks in UFD.. CLR UTOTFL ; .. and total number of files CLR UTOTBL+2 ; CLR UTOTFL+2 ; ; 10$: CALL NXTFIL ; Get the next file BCS 40$ ; If CS no more - output totals TST FNAM ; Any filename to check BEQ 20$ ; If eq no - omit check CMP FNAM,U.NAM(R3) ; Yes - same? BNE 10$ ; No - try next file CMP FNAM+2,U.NAM+2(R3) ; Sure? BNE 10$ ; If ne no - try next file ; 20$: TST FEXT ; Any extension? BEQ 30$ ; If eq no - omit check CMP FEXT,U.EXT(R3) ; Yes - same extension? BNE 10$ ; If ne no - try next file ; 30$: BIT #HDPT,SWMSK$ ; Have we done this heading? BNE 35$ ; If ne yes - don't do it again BIS #HDPT,SWMSK$ ; Show we've done the heading CALL CNVUIC ; Convert the UIC MOV #ARGBLK,R0 ; Get address of argument block MOV #DVNM,(R0)+ ; Address of Device Name MOV UNIT,(R0)+ ; Unit MOV #UICSTR,(R0)+ ; Insert address of UIC string MOV #IUFHD1,R1 ; Get address of Heading CALL OUTLST ; Output it MOV #IUFHD2,R1 ; And second line CALL OUTLST ; MOV #IBLANK,R1 ; And a blank line CALL OUTLST ; ; 35$: BIS #FLFL,SWMSK$ ; We found a file MOV U.NAM(R3),ARGBLK ; Store Filename MOV U.NAM+2(R3),ARGBLK+2 ; MOV U.EXT(R3),ARGBLK+4 ; and extension CLR ARGBLK+10 ; Initialise next word MOVB U.FPR(R3),ARGBLK+10 ; Put the protection code in MOV (R3),ULNK ; Save the link ADD #U.FAA,R3 ; Get address of link to accounting block CALL GETBLK ; Get the accounting block MOV U.SIZ(R3),ARGBLK+6 ; Get file size MOV U.DCR(R3),DATE ; Get the creation date MOV #ARGBLK+12,R0 ; Get address fro converted date CALL CNVDAT ; Convert the date from RSTS to $EDMSG format MOV #IUFDL1,R1 ; Get Instruction String Address CALL OUTLST ; Output to the Listing File ADD U.SIZ(R3),UTOTBL+2 ; Count the blocks ADC UTOTBL ADD #1,UTOTFL+2 ; Count the File ADC UTOTFL ; Add in carry MOV #ULNK,R3 ; Get address of link back BR 10$ ; Get the next File ; 40$: BIT #HDPT,SWMSK$ ; Any files in that one BEQ 45$ ; If eq no - omit trailer BIC #HDPT,SWMSK$ ; Yes - clear flag for next time ADD UTOTBL+2,GTOTBL+2 ; Update grand totals ADC GTOTBL ADD UTOTBL,GTOTBL ADD UTOTFL+2,GTOTFL+2 ADC GTOTFL ADD UTOTFL,GTOTFL MOV #IBLANK,R1 ; Output a blank Line CALL OUTLST ; CALL CNVUIC ; Convert the UIC MOV #ARGBLK,R0 ; Get address of argument block MOV #UTOTBL,(R0)+ ; Store total blocks MOV #UTOTFL,(R0)+ ; and total files MOV #DVNM,(R0)+ ; Address of Device Name MOV UNIT,(R0)+ ; Unit MOV #UICSTR,(R0)+ ; Insert address of UIC string MOV #IUFDL2,R1 ; and the Totals Line CALL OUTLST ; MOV #IBLANK,R1 ; and another blank line CALL OUTLST ; Output to the Listing File ; 45$: MOV UFDADD,R3 ; Restore address of UFD TST NXUIC$ ; Wild-card UIC? BEQ 60$ ; If eq no - exit JMP 5$ ; Yes - get next one ; 50$: BIT #FLFL,SWMSK$ ; Any files found? BEQ 60$ ; No - Give up MOVB WCUSR$,UFDNO ; Fake the UFD MOVB WCGRP$,UFDNO+1 ; CALL CNVUIC ; Convert the UIC MOV #ARGBLK,R0 ; Get address of Argument Block MOV #GTOTBL,(R0)+ ; Set up the argument block MOV #GTOTFL,(R0)+ ; MOV #DVNM,(R0)+ ; MOV UNIT,(R0)+ ; MOV #UICSTR,(R0)+ ; MOV #IUFDL3,R1 ; Get parameter string CALL OUTLST ; Output it ; 60$: RETURN .PAGE .SBTTL FILCPY Copy one or more files ; ; This routine copies one or more files from the input disk to the ; output device. ; FILCPY: MOV #MFDLNK,R3 ; Set up address of Link Word ; 10$: CALL GETUFD ; Get the next UFD BCC 30$ ; If cc OK - carry on JMP 140$ ; Exit ; 30$: CALL NXTFIL ; Get the next file BCC 40$ ; If cc OK - carry on MOV UFDADD,R3 ; Restore address of UFD TST NXUIC$ ; Wild-card UIC? BNE 10$ ; If ne yes - get next one JMP 140$ ; No - exit ; 40$: TST FNAM ; Wildcard filename? BEQ 50$ ; If eq yes - this one's OK then CMP FNAM,U.NAM(R3) ; Same file? BNE 30$ ; If ne no - try next one CMP FNAM+2,U.NAM+2(R3) ; Sure? BNE 30$ ; If ne no - try next one ; 50$: TST FEXT ; Wildcard extension? BEQ 60$ ; If eq yes - this one's all right CMP FEXT,U.EXT(R3) ; Sure? BNE 30$ ; If ne no - try next one ; 60$: BIS #FLFL,SWMSK$ ; We found One! BIT #FOPN,SWMSK$ ; Output file already open? BNE 70$ ; If ne yes - carry on MOV U.NAM(R3),OUTFDB+F.FNB+N.FNAM ; Specify the.. MOV U.NAM+2(R3),OUTFDB+F.FNB+N.FNAM+2 ;.. CLR OUTFDB+F.FNB+N.FNAM+4 ;..output filename.. MOV U.EXT(R3),OUTFDB+F.FNB+N.FTYP ;..and extension CLR OUTFDB+F.FNB+N.FVER ;..and version MOV #OUTFDB,R0 ; SET FILE-DESCRIPTOR-BLOCK MOV #,R1 ; AND FILE-NAME-BLOCK FOR PARSE CALL .OPFNB ; OPEN THE FILE BCC 70$ ; BR IF A-OK FERR OPNO ; FATAL OPEN ON OUTPUT FILE ; 70$: MOV #OUTBLK,RECPNT ; Initialise the output pointer MOV (R3),ULNK ; Save the link MOV U.RIB(R3),RIBLNK; Save the link word to the RIB ADD #U.FAA,R3 ; Get address of link to accounting block CALL GETBLK ; Get the accounting block MOV (R3),ATTLNK ; Save the Link to the Attributes Block MOV U.SIZ(R3),FSIZ ; Save the file size MOV U.FCL(R3),FCLS ; Save the file cluster size ; 80$: MOV #RIBLNK,R3 ; Get address of link to first RIB CALL GETBLK ; Get the RIB MOV (R3)+,RIBLNK ; Store the next link MOV #7,R4 ; Seven clusters in this RIB ; 90$: MOV (R3)+,R0 ; Get next cluster number BEQ 120$ ; If eq try next one MUL DVCLSZ,R0 ; Multiply by Disk Cluster Size MOV FCLS,R2 ; Store Cluster Size SUB FCLS,FSIZ ; Decrement remaining size BGE 100$ ; If GT OK - carry on ADD FSIZ,R2 ; Else reset size ; 100$: QIOW$S #IO.RLB,#INPLUN,#1,,#IOSB,,<#RECBUF,#512.,,R0,R1> ; Read in the next block TSTB IOSB ; I/O OK? BPL 110$ ; If PL Yes - carry on MOVB IOSB,R0 ; Sign-extend the error FERR READ,R0 ; No - log error ; 110$: CALL OUTREC ; Output it ADD #1,R1 ; Set to next block ADC R0 ; SOB R2,100$ ; and do next block ; 120$: TST FSIZ ; Any more of the file? BLE 130$ ; If le no - exit DEC R4 ; Any more entries in this RIB BGT 90$ ; If gt yes - do next one TST RIBLNK ; Another RIB? BNE 80$ ; If ne yes - get it ; 130$: BIT #FOPN,SWMSK$ ; Output File Specified? BNE 135$ ; If NE yes - close it later CLOSE$ #OUTFDB ; No - close it now ; 135$: MOV #ULNK,R3 ; Reset link pointer address JMP 30$ ; Get next file ; 140$: BIT #FLFL,SWMSK$ ; Have we found any files? BNE 150$ ; Yes - omit diagnostic DIAG NOFL ; No Such File ; 150$: RETURN .PAGE .SBTTL OUTREC Output the File's records ; ; This routine splits up the current block into records and outputs it ; to the output file. ; ; On Input:- ; RECPNT = current offset in output record ; RECBUF holds the latest block ; On Output:- ; RECPNT = current offset in output record ; OUTREC: MOV R0,-(SP) ; MOVB #R.VAR,OUTFDB+F.RTYP ; Default to Variable Length BITB #IMSW,SWMSK$ ; /IM specified? BEQ 5$ ; If EQ no - carry on MOVB #R.FIX,OUTFDB+F.RTYP ; Yes - reset to Fixed PUT$ #OUTFDB,#RECBUF,#512. ; Yes - output the whole thing JMP 110$ ; and do next block ; 5$: MOV R3,-(SP) ; Save some registers MOV R2,-(SP) ; MOV R1,-(SP) ; MOV #RECBUF,R3 ; POINT TO BLOCK BUFFER MOV #512.,R2 ; GET SIZE MOV RECPNT,R1 ; Get current output address ; 10$: BIT #BASW,SWMSK$ ; /BA specified? BNE 15$ ; If NE yes - LF doesn't terminate CMPB (R3),#12 ; Next byte a LF? BEQ 30$ ; If eq yes - end of record ; 15$: CMPB (R3),#15 ; Next byte a CR? BNE 20$ ; If NE no - check next one BIT #BASW,SWMSK$ ; /BA specified? BEQ 30$ ; If eq no - end of record CMPB 1(R3),#12 ; Proper CRLF pair? BNE 20$ ; No - carry on INC R3 ; Count the CR DEC R2 ; Count it BR 30$ ; End of record ; 20$: CMP R1,#OUTBLK+1536. ; Room for record? BGT 100$ ; No - exit (and hope it's the end) MOVB (R3)+,(R1)+ ; Yes - copy it over SOB R2,10$ ; And check next one BR 100$ ; End of block - get next one ; 30$: INC R3 ; Count the LF or CR DEC R2 ; BEQ 40$ ; If eq no more - stop looking for terminators CMPB (R3),#15 ; another CR? BEQ 30$ ; If eq yes - omit that as well CMPB (R3),#12 ; another LF? BEQ 30$ ; If eq yes - omit that as well TSTB (R3) ; a null? BEQ 30$ ; If eq yes - omit that as well ; 40$: SUB #OUTBLK,R1 ; Get length of record PUT$ #OUTFDB,#OUTBLK,R1 ; Output the record MOV #OUTBLK,R1 ; Reset output address TST R2 ; Anything left in block? BGT 10$ ; Yes - get next record ; 100$: MOV R1,RECPNT ; Store output address MOV (SP)+,R1 ; Restore registers MOV (SP)+,R2 ; MOV (SP)+,R3 ; ; 110$: MOV (SP)+,R0 ; RETURN ; .PAGE .SBTTL NXTUFD Get the Next UFD ; ; This routine reads the MFD to find the next valid UFD entry ; NXTUFD: BIT #NMSW,SWMSK$ ; /NM specified? BEQ 5$ ; If eq no - follow MFD links as usual ADD #16.,LNKBLO ; Yes - set address to next blockette CMP LNKBLO,#512. ; End of block? BLO 20$ ; If lo no - check this blockette CLR LNKBLO ; Yes - update offset MOV MFDBLK,BLOCK ; Store the block number MOV MFDBLK+2,BLOCK+2 ; ADD #1,BLOCK+2 ; Increment the block number ADC BLOCK ; BR 10$ ; and go read it ; 5$: TST (R3) ; Any more records? BEQ 30$ ; If eq no - exit CALL CNVLNK ; Convert it MOV LNKCLS,R0 ; Get Cluster Number ASL R0 ; Convert to Word Offset MOV MFDBUF+M.DCN(R0),CLSDCN ; Get Device Cluster Number CALL CNVCLS ; Convert that to a Block Number CMP BLOCK,MFDBLK ; Got this already? BNE 10$ ; No - read it CMP BLOCK+2,MFDBLK+2 ; Sure we've got it? BEQ 20$ ; Yes - omit the read ; 10$: MOV BLOCK,MFDBLK ; Update MFD Block Number MOV BLOCK+2,MFDBLK+2; MOV BLOCK+2,R5 ; Store in register to be visible QIOW$S #IO.RLB,#INPLUN,#1,,#IOSB,,<#MFDBUF,#512.,,BLOCK,BLOCK+2> ; Read the relevant block TSTB IOSB ; I/O OK? BPL 20$ ; If PL Yes - carry on MOVB IOSB,R0 ; Sign-extend the error FERR READ,R0 ; No - log error ; 20$: MOV #MFDBUF,R3 ; Get address of Blockette ADD LNKBLO,R3 ; BITB #S.UFD,M.UST(R3) ; UFD Entry? BEQ NXTUFD ; If EQ no - try next one CLC ; Yes - OK BR 40$ ; Exit ; 30$: SEC ; Not found ; 40$: RETURN ; .PAGE .SBTTL NXTFIL Get the Next File ; ; This routine reads the UFD to find the next valid File entry ; NXTFIL: TST (R3) ; Any more records? BEQ 30$ ; If eq no - exit CALL GETBLK ; Get the Block BITB #S.UFD,M.UST(R3) ; UFD Entry? BNE NXTFIL ; If eq yes - try next one CLC ; Yes - OK BR 40$ ; Exit ; 30$: SEC ; Not found ; 40$: RETURN ; .PAGE .SBTTL GETBLK Read a UFD Block ; ; This routine reads a particular block in the UFD ; ; On Input:- ; R3 = Address of Link Word ; On Output:- ; R3 = Address of Blockette ; UFDBUF contains the Block ; GETBLK: CALL CNVLNK ; Convert it MOV LNKCLS,R0 ; Get Cluster Number ASL R0 ; Convert to Word Offset MOV UFDBUF+U.DCN(R0),CLSDCN ; Get Device Cluster Number CALL CNVCLS ; Convert that to a Block Number CMP BLOCK,UFDBLK ; Got this already? BNE 10$ ; No - read it CMP BLOCK+2,UFDBLK+2 ; Sure we've got it? BEQ 20$ ; Yes - omit the read ; 10$: MOV BLOCK,UFDBLK ; Update UFD Block Number MOV BLOCK+2,UFDBLK+2; QIOW$S #IO.RLB,#INPLUN,#1,,#IOSB,,<#UFDBUF,#512.,,BLOCK,BLOCK+2> ; Read the relevant block TSTB IOSB ; I/O OK? BPL 20$ ; If PL Yes - carry on MOVB IOSB,R0 ; Sign-extend the error FERR READ,R0 ; No - log error ; 20$: MOV #UFDBUF,R3 ; Get address of Blockette ADD LNKBLO,R3 ; RETURN ; .PAGE .SBTTL CNVDAT Convert Date to right format ; ; This routine converts a date from RSTS Internal format to the format ; required by $EDMSG. ; ; On Input:- ; DATE = date for conversion ; R0 = address to store output (year, month ,day) ; ; Note:- ; RSTS dates are stored as (Year-1970)*1000+Day of Year ; CNVDAT: MOV R0,-(SP) ; Save the output address CLR R0 ; Clear for division MOV DATE,R1 ; Get date DIV #1000.,R0 ; Get year and day of year MOV R0,@(SP) ; Store year MOV (SP)+,R0 ; Get address back ADD #70.,(R0) ; Update year BIT #3,(R0)+ ; Leap Year? BNE 20$ ; If ne no - carry on CMP R1,#60. ; 29th Feb? BLO 20$ ; If lo earlier - treat as ordinary year BHI 10$ ; If hi subtrat one and carry on MOV #2,(R0)+ ; Yes - put in by hand MOV #29.,(R0)+ ; BR 50$ ; and exit ; 10$: DEC R1 ; Discount the 29th February ; 20$: MOV #24.,R2 ; Twelve months to check ; 30$: CMP DATES-2(R2),R1 ; After this month? BLO 40$ ; If lo yes - carry on DEC R2 ; SOB R2,30$ ; no - try next one ; 40$: SUB DATES-2(R2),R1 ; Get day in month ASR R2 ; Convert to month number MOV R2,(R0)+ ; Store the month MOV R1,(R0)+ ; Store day as well ; 50$: RETURN .PAGE .SBTTL CNVUIC Convert a UIC to ASCII ; ; This routine converts a one-word UIC to an ASCII string. ; ; On Input:- ; UFDNO = UIC ; On Output:- ; UICSTR contains the converted UIC ; CNVUIC: MOV #UICSTR+9.,R0 ; Get end of string MOV #8.,R2 ; Get amount to blank ; 10$: MOVB #' ,-(R0) ; Blank a byte SOB R2,10$ ; and so on MOVB UFDNO+1,R1 ; Get Group Number CMP R1,#-1 ; Wildcard? BNE 20$ ; If ne no - carry on MOVB #'*,(R0)+ ; Yes - insert the asterisk BR 30$ ; and omit conversion ; 20$: BIC #177400,R1 ; Clear any Sign Extension CALL $CBOMG ; Convert the Number ; 30$: MOVB #',,(R0)+ ; Insert a comma MOVB UFDNO,R1 ; Get User Number CMP R1,#-1 ; Wildcard? BNE 40$ ; If ne no - carry on MOVB #'*,(R0)+ ; Yes - insert the asterisk BR 50$ ; and omit conversion ; 40$: BIC #177400,R1 ; Clear any Sign Extension CLR R2 ; Zero Suppression CALL $CBOMG ; Convert it ; 50$: MOVB #'],(R0)+ ; Insert a ] RETURN .PAGE .SBTTL OUT Output Routines ; FERR: CALL DIAG ; Output the Message JMP RTR2 ; Get the next command ; DIAG: MOV #DIAGBK,R0 ; CALL OUT1 ; Output QIOW$S #IO.WLB,#4,#1,,,,<#DIAGBK,R1,#40> ; Output to TI: RETURN ; Return ; OUTLST: CALL OUT ; Output PUT$ #OUTFDB,#OUTBLK,R1 ; Output the Message RETURN ; Return ; OUT: MOV #OUTBLK,R0 ; Get Buffer for Output ; OUT1: MOV #ARGBLK,R2 ; Get Address of any Parameters CALL $EDMSG ; Edit the Message RETURN .PAGE .SBTTL DATA Definitions .NLIST BEX ; ; This area defines all the data areas referenced by the program. ; MFDBUF: .BLKB 512. ; Buffer for 1st block of MFD MFDBLK: .BLKW 2 ; Block Number of Block in MFDBUF MFDLNK: .WORD ; First Link to MFD Name Block IOSB: .BLKW 2 ; I/O Status Block for I/Os UFDNO: .WORD ; Current UIC SAVSP: .WORD ; Saved Stack Pointer LNKBLK: .WORD ; Block Number LNKCLS: .WORD ; Cluster Number LNKBLE: .WORD ; Blockette Number LNKBLO: .WORD ; Blockette Offset LNKFLG: .WORD ; 'In Use' Flag CLSDCN: .WORD ; DCN of File Cluster DVCLSZ: .WORD ; Device Cluster Size BLOCK: .BLKW 2 ; Block to be read. UFDBUF: .BLKB 512. ; UFD Block UFDBLK: .BLKW 2 ; Block Number of Block in UFDBUF UFDLNK: .WORD ; First Link to UFD Name Block ULNK: .WORD ; General UFD Link Store UTOTBL: .BLKW 2 ; Total Blocks in UFD UTOTFL: .BLKW 2 ; Total Files in UFD GTOTBL: .BLKW 2 ; Total Blocks GTOTFL: .BLKW 2 ; Total Files UFDADD: .WORD ; Address of UFD entry in MFDBUF RECBUF: .BLKB 512. ; RECORD BUFFER RECPNT: .WORD RECBUF ; POINTER IN RECORD BUFFER FSIZ: .WORD ; File size FCLS: .WORD ; File cluster size RIBLNK: .WORD ; Link to next RIB ATTLNK: .WORD ; Link to Attributes Block OUTBLK: .BLKB 1536. ; Buffer for Messages ARGBLK: .BLKW 10. ; Arguments for $EDMSG DIAGBK: .BLKB 80. ; For Diagnostics DATE: .WORD ; Date for conversion DATES: .WORD 0,31.,59.,90.,120.,151. .WORD 181.,212.,242.,273.,303.,334. UICSTR: .ASCII /[/ .BLKB 8. IMFHD1: .ASCIZ / UFD Password/ IMFHD2: .ASCIZ / === ========/ IUFHD1: .ASCIZ / Name .Ext Size Prot Date%7S%2A%M:%9A/ IUFHD2: .ASCIZ / ========= ==== ==== ====/ IMFDL1: .ASCIZ /%5S%9A%2S%2R/ IUFDL1: .ASCIZ /%2R.%R %7<%M%7><%3<%M%3>> %Y/ IUFDL2: .ASCIZ /Total of %T blocks in %T files in %2A%M:%9A/ IUFDL3: .ASCIZ /Grand total of %T blocks in %T files in %2A%M:%9A/ IBLANK: .ASCIZ / / INRSTS: .ASCIZ /RTR - Pack is not a RSTS-E Pack!/<7> IGCME: .ASCIZ /RTR - CMD READ ERROR/<7> ICS1E: .ASCIZ /RTR - CMD SYNTAX ERROR/<7> ICS2I: .ASCIZ /RTR - ERROR IN INPUT SPEC/<7> ICS2O: .ASCIZ /RTR - ERROR IN OUTPUT SPEC/<7> IPRSE: .ASCIZ /RTR - PARSE ERROR/<7> IOPNO: .ASCIZ /RTR - OPEN ERROR ON OUTPUT/<7> INOFL: .ASCIZ /RTR - NO SUCH FILE(S)/<7> IREAD: .ASCIZ /RTR - Error = %D while reading disk/<7> .EVEN ; ; CSI Tables ; SWTABL: CSI$SW DI,DISW,SWMSK$,SET,NEG CSI$SW SP,SPSW,SWMSK$,SET,NEG CSI$SW LI,LISW,SWMSK$,SET,NEG CSI$SW IM,IMSW,SWMSK$,SET,NEG CSI$SW BA,BASW,SWMSK$,SET,NEG CSI$SW HE,HESW,SWMSK$,SET CSI$SW NM,NMSW,SWMSK$,SET,,NMVTBL CSI$ND NMVTBL: CSI$SV ASCII,UFDPWD,6 CSI$ND UFDPWD: .BLKW 3 DISW=1 LISW=2 SPSW=4 FLFL=10 FOPN=20 HDPT=40 IMSW=100 HESW=200 NMSW=400 BASW=1000 FSRSZ$ 2 ; ; ; COMMAND BUFFER & CONTROL BLOCK ; CSIBLK: .BLKB C.SIZE ; .EVEN CMDBLK: GCMLB$ 2,RTR,LINBUF,CMDLUN ; CMDSIZ=CMDBLK+G.CMLD ; DEFINE COMMAND SIZE ADDRESS CMDADR=CMDSIZ+2 ; ...AND ADDRESS POINTER .EVEN ; INPFDB: FDBDF$ FDOP$A INPLUN FNAM=INPFDB+F.FNB+N.FNAM FEXT=INPFDB+F.FNB+N.FTYP DVNM=INPFDB+F.FNB+N.DVNM UNIT=INPFDB+F.FNB+N.UNIT INPDFN: NMBLK$ ,,0,SY,0 ; OUTFDB: FDBDF$ FDAT$A R.VAR,FD.CR FDRC$A ,LINBUF,80. FDOP$A OUTLUN,,,FO.WRT OUTDFN: NMBLK$ ,,0,SY,0 SWMSK$: .BLKW 1 ; SWITCH BITS HERE TDBUF$: .BLKB 16. ; TODAY'S DATE NXUIC$: .BLKW 1 ; NEXT UIC TO CHECK WCGRP$: .BYTE ; GROUP CODE OR 0 FOR WILD CARD GRP WCUSR$: .BYTE ; USER NUMBER OR ZERO FOR WILD LINBUF: .BLKB 80. HLSPWN: SPWN$ MCR...,,,,,1,,,HELCMD,HELCML HELCMD: .ASCII /HELP RTR/ HELCML=.-HELCMD .EVEN .END RTR