.MCALL .MODULE .MODULE DUPIN1,VERSION=13,COMMENT=,IDENT=NO,GLOBAL=.DPIN1 ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ; Edit History: ; ; 001 28-Jan-80 10:32 Guldenschuh, Chuck cpg [240,148] ; Correct "Volume not RT-11 format" problem ; (001) ; 002 19-Feb-80 13:55 Metsch, James (29602) [240,122] ; Correct INIT DK problem ; (002) ; 003 20-Mar-81 03:02 PM David Fingerhut [240,134] ; /START:0/END:0 copies entire disk. ; (003) ; 004 19-Aug-81 09:01 AM David Fingerhut [40,134] ; Multiple options w /WAIT gives too many prompts. 11-40025 ; (004) ; 005 20-Aug-81 04:01 PM David Fingerhut [40,134] ; clear mntflg on startup and restart ; (005) ; 006 17-Dec-81 12:10 PM David Fingerhut [40,134] ; allow /ALLO:0 to create a 0 length file ; (006) ; 007 16-Feb-82 12:47 PM David Fingerhut [40,134] ; MDUP assembly error ; (007) ; 1-NOV-84 10:00 AM George Thissell [240,140] ; add /V switch for MDUP ; 1-MAY-85 George Thissell ; don't allow for file processing during any /V option ; ; 012 06-Nov-1990 JFW ; bracket error messages with ;+/;ERROR/.../;- ; ; (013) 10-Jul-91 MBG Correct logic surrounding /V[:ONL] option ; and when the volume ID should be printed .MCALL ...CMZ,...CMY .ENABL LC .SBTTL Edit History ; CG01 Add .CLOSE error check DUPIN1 EL42 DUP V04.00A ; CG03 Fix error in MDUP assembly DUPIN1 EL43 DUP V04.00A ; 010 5-JUL-88 George Stevens ; Remove /R from /I command add /J to /I command .SBTTL PSECT definitions .IIF NDF MDUP, MDUP = 0 ;Default to no MDUP .IIF NDF M$UPD, M$UPD = 0 ;Default to no MDUP Update .IIF NDF SDC, SDC = 0 ;Default to no SDCOPY .IIF NDF .DBG., .DBG. == 0 ;Default to no debugging .IIF NDF IND, IND = 0 ;Default to no IND .ENABL GBL .SBTTL Psect ordering for overlay segment 1 PSECT ...AFL ; PSECT ...ERS ; ;001 PSECT ...MFL ; PSECT IMPURE ;Impure data psect PSECT IMPURO ; ;001 PSECT .LIBD. ;Library data (error messages) PSECT .LIBP. ;Library pointers (error messages) PSECT PUREB ;[byte] Pure data PSECT CLEAR0 ;List of items to cleared on start-up CLRLS0:: ; Reference label PSECT CLEAR1 ;List of blocks to be cleared on start-up .WORD 0 ; Stopper for CLRLS0 CLRLS1:: ; Reference label PSECT SETIT0 ;List of blocks to set to a value on start-up .WORD 0 ; Stopper for CLRLS1 SETLS0:: ; Reference label PSECT SWITAB ;Valid option character table (SWITCH macro) .WORD 0 ; Stopper for SETLS0 SWTLST:: ; Reference label PSECT FLGTBL ;Flag word table (SWITCH macro) .WORD 0 ; Stopper for SWTLST FLGTAB:: ; Reference label PSECT BITTBL ;Table of option flag bits (SWITCH macro) BITABL:: ; Reference label PSECT ACTABL ;Action routine table (SWITCH macro) ACTLST:: ; Reference label PSECT EXCTBL ;Table of option mutual exclusion bits EXCLST:: ; Reference label PSECT PROCES ;Table of option processing routines PROTBL:: ; Reference label PSECT RESTR1 ;Code psect PSECT PATCH ;Patch psect .BLKW 32. .SBTTL Error Messages .IF EQ MDUP .MACRO ERRMSG NAME,TEXT DS NAME,BYTE .PSECT .LIBD. EM.'NAME: .ASCII \TEXT\<200> .PSECT .LIBP. .WORD EM.'NAME .ENDM ERRMSG .MACRO MSGLST NAME .DSECT ...ERS,GLOBAL=NO .PSECT .LIBP. NAME: .WORD ..MAX. .ENDM MSGLST .MACRO MSGEND DS ..MAX.,BYTE .ENDM MSGEND ;+ ;ERROR MSGLST OERTAB ERRMSG ILO, ERRMSG IOV, ERRMSG WVR, MSGEND ;- .SBTTL Impure data PSECT IMPURO ;Error message area block OEAREA: .BYTE 0 ; Error code byte .BYTE 0 ; Error level/return flag .WORD ERRPRE ; -> Error message prefix .WORD ERRLEV ; -> Error level byte .WORD OERTAB ; -> Error message offset table .WORD 0 ; -> File name block .WORD ABORT ; -> Abort return .ENDC ;EQ MDUP .IF NE IND ;005 APTMP:: .RAD50 \DK AP \ ;005 .RAD50 \TMP\ ;005 .ENDC ; .IF NE IND .SBTTL Option definitions ;+ ; SWITCH ; The following macro is used to define all options for DUP. The first ; is the CSI switch. The second argument is the option processing ; routine to call when the switch is encountered. This routine checks ; for validity of arguments, sets the appropriate flag bit, and checks ; for mutual exclusion of options. The next argument is the flag word ; in which to set the flag bit. $AFLAG is for action options, and ; $MFLAG for modification options. The fourth argument is the routine ; which will execute the command for this option. The final argument is ; the list of mutually exclusive options. This is not used in the ; modification options, since they can all be valid at the same time. ; ; The table is broken into three sections. The first section consists ; of actions which can have other actions associated. THIS SECTION IS ; ORDER DEPENDENT. Actions are executed in the same order as they are ; defined in the option table. The next section is the rest of the ; action options. The third section is the modification options. ;- .MACRO SWITCH CHAR,PROC,ABIT,FLAG,ACTION,EXC .DSABL CRF BS ABIT ;Define flag bit for /'CHAR option EX.'CHAR = ABIT PSECT SWITAB .BYTE ''CHAR PSECT FLGTBL .WORD FLAG PSECT BITTBL .WORD ABIT PSECT PROCES .IF NB PROC .WORD PROC .IFF .WORD 0 .ENDC .IF NB ACTION PSECT ACTABL .WORD ACTION .ENDC ..EXC. = 0 .IF NB .IRP ARG, .IF DF EX.'ARG ..EXC. = ..EXC. ! EX.'ARG .ENDC .ENDM .ENDC PSECT EXCTBL .WORD ..EXC. ;Exclusion bits for /'CHAR option .ENABL CRF .ENDM SWITCH .BSECT ...AFL,GLOBAL=YES .IF EQ MDUP .IF EQ SDC SWITCH Z ZERVAL FL.ZRO $AFLAG ZERO SWITCH V VOLVAL FL.ONL $AFLAG VOLID SWITCH K ,, FL.SCN $AFLAG SCAN SWITCH S SQUINI FL.SQU $AFLAG SQUEEZ SWITCH O ,, FL.BOT $AFLAG BOOT .ENDC ;EQ SDC .IFF ;EQ MDUP SWITCH Z ZERVAL FL.ZRO $AFLAG ZERO SWITCH H BLDFIX FL.BLD $AFLAG BUILD SWITCH . ,, FL.COP $AFLAG COPYMT .IFT ;EQ MDUP .IF EQ SDC SWITCH C ,, FL.CRE $AFLAG CREATE SWITCH D UNIFIX FL.UNI $AFLAG UNINIT SWITCH I ,, FL.IMA $AFLAG IMAGE SWITCH T EXTVAL FL.EXT $AFLAG CREATE SWITCH U BOOFL FL.WBT $AFLAG WBOOT SWITCH V ,, FL.VPT $AFLAG VOLID .IFF ;EQ SDC SWITCH C ,, FL.COP $AFLAG IMAGE FL.IMA == FL.COP .ENDC ;EQ SDC .IFTF ;EQ MDUP .BSECT ...MFL,GLOBAL=YES .IFT ;EQ MDUP .IF EQ SDC SWITCH B RETVAL FL.BAD $MFLAG .IFF ;EQ SDC SWITCH V ,, FL.VER $MFLAG .ENDC ;EQ SDC .IFF ;EQ MDUP SWITCH B ,, FL.BAD $MFLAG SWITCH T EXTVAL FL.PLT $MFLAG SWITCH V VMSWIT FL.VM $MFLAG .IFT ;EQ MDUP .IF EQ SDC SWITCH E ENDVAL FL.END $MFLAG .IFTF ;EQ SDC SWITCH F ,, FL.FIL $MFLAG .IFT ;EQ SDC SWITCH G STRVAL FL.STR $MFLAG SWITCH H ,, FL.WRT $MFLAG SWITCH J ,, FL.IGN $MFLAG SWITCH N SEGVAL FL.SEG $MFLAG SWITCH Q ,, FL.FOR $MFLAG SWITCH R RETVAL FL.REP $MFLAG SWITCH W ,, FL.WAT $MFLAG SWITCH X ,, FL.NBT $MFLAG SWITCH Y ,, FL.YES $MFLAG BS FL.VOL ;Special case for /V FL.VER == FL.WRT ;Multiplexed /H .ENDC ;EQ SDC .ENDC ;EQ MDUP .SBTTL List of things to clear on start-up and restart ;+ ; CLRLST ; The following list contains the addresses of all items which must be ; cleared on start-up and restart. ;- PSECT CLEAR0 .WORD $AFLAG ;Action option flag word .WORD $ISFLG ;Input file flag word .WORD $OSFLG ;Output file flag word .WORD $MFLAG ;Modification option flag word .WORD BADLHD ;-> bad block scan bad block list .WORD EXTSIZ ;/T size .WORD FREMLH ;-> 1st word of free memory .WORD FREMLH+2 ;Must ALWAYS be 0. Help make sure here .WORD REDEND ;/E value .WORD REDSTR ;/G value (input) .WORD REDSW ;/E Specification switch .WORD SCCNT ;CTRL/C intercept count .WORD SEGMNT ;Number of directory segments .WORD WRTSTR ;/G value (output) .WORD XTRBYT ;Number of extra bytes/entry .WORD DEFEXT ;Default extensions .WORD DEFEXT+2 ;Default extensions .WORD DEFEXT+4 ;Default extensions .WORD DEFEXT+6 ;Default extensions .IF EQ MDUP ;**-1 .WORD MNTFLG ;Flags for use in WAITCK ;007 .WORD RETAIN ;/B,/R :RET flag .WORD VOLFLG ;/V state indicator .ENDC ;EQ MDUP ;+ ; CLRLS1 ; The following list contains blocks of data to be cleared on start-up and ; restart. The list consists of the address of the block and the size of the ; block in words. ;- PSECT CLEAR1 .WORD $AVAIL, DDATSZ ;Main directory impure area .WORD $IAVAL, DDATSZ ;Secondary directory impure area .IF EQ MDUP ;CG03+ .WORD $OAVAL, DDATSZ ;Output directory impure area .ENDC ;EQ MDUP ;CG03- .SBTTL INIT - Start-up initialization ;+ ; INIT ; This next section of code cleans up for a restart. It purges all ; channels, releases all handlers, resets memory to the program high ; limit, gets the time-of-day and the date (to cause date roll-over). ;- ORIGIN RESTR1 .ENABL LSB INIT:: MOV #HICHAN,R1 ;Get the highest channel in use 1$: .CLOSE R1 ;Close any file opened on it BCC 2$ ;Branch if not error ;CG01 ;+ ;ERROR .ERR #ERAREA,#FE.FCP,LEVEL=WARNING,RETURN=YES,FILE=#OUTFIL ;CG01 ; <-W-File created:protected file already exists DEV:FILENAME> ;CG01 ;- 2$: DEC R1 ;Decrement the count BPL 1$ ;Loop until done .IF EQ MDUP MOV #OUTFIL,R1 ;Point to the CSI file specs 3$: TST @R1 ;Anything there? BEQ 4$ ;Branch if not .RELEAS R1 ;Release the handler 4$: ADD #OUSPSZ,R1 ;Bump the pointer to the next spec CMP #,R1 ;Thru with the output file specs? BHIS 3$ ;Branch if not TST -(R1) ;Input specs are 1 word shorter CMP #,R1 ;Thru with input specs? BHI 3$ ;Branch if not .ENDC ;EQ MDUP MOV LIMITS+2,R0 ;Get pointer to 1st word of free memory .SETTOP ;Settop to that MOV #CLRLS0,R1 ;Point to list of things to clear 5$: CLR @(R1)+ ;Clear it TST @R1 ;Done? BNE 5$ ;Branch if not MOV #CLRLS1,R1 ;Point to list of blocks to be cleared 6$: MOV (R1)+,R0 ;Get the address BEQ 11$ ;Branch if done MOV (R1)+,R2 ;Get the size of the block 7$: CLR (R0)+ ;Clear a word SOB R2,7$ ; BR 6$ ; .IF NE 0 ; This next section of code is commented out because there is currently ; no need for it. But if there ever is... 8$: MOV #SETLS0,R1 ;Point the list of blocks to be set 9$: MOV (R1)+,R0 ;Get the address BEQ 11$ ;Branch if done MOV (R1)+,R2 ;Get the number of words to be set MOV (R1)+,R3 ; and the value 10$: MOV R3,(R0)+ ;Set the value SOB R2,10$ ;Loop BR 9$ ; .ENDC ;NE 0 11$: ;CG03 .IF EQ MDUP .GVAL #IOAREA,#S.VER ;Get the system version number BIC #^C377,R0 ;Clear the update number CMP R0,#5 ;Is it the right version? VERCHK::BGE 13$ ;Branch if so ;+ ;ERROR 12$: .ERR #OEAREA,#WVR,LEVEL=UABORT,RETURN=YES ; <-U-Wrong version of RT-11> ;- CLR R0 ;Hard exit .EXIT ;Get out quick 13$: MOV #15.,R0 ;Point to overlay channel MOV #SYSDEV,R1 ;Storage area for system device name CALL REALDV ;Go make it real BCS 12$ ;Wrong version!!! .ENDC ;EQ MDUP .GTIM #IOAREA,#TIME ;Get time-of-day (and maybe cause date roll) .DATE ;Get the date MOV R0,DATE ;Save it .RCTRLO ;Reset CTRL/O CALL NOSCCA ;Reset ^C intercept ;Must be done after CLRLST RETURN .DSABL LSB .SBTTL Command line processing routines .SBTTL DECODE - Command line parsing ;+ ; DECODE ; This routine processes the command line. It determines whether or ; not an option is valid, and if so, dispatches to the routine defined ; by the SWITCH macro for further processing. The routines are passed ; the following information: ; ; R0 = The value for the switch or 0 ; R1 = The switch ; ; R4 and R5 must not be modified by the processing routines. ; ; JSR PC,DECODE ; ; R0 - R5 modified ;- .ENABL LSB DECODE::...CMZ MOV (SP)+,R5 ;Save the return address MOV (SP)+,R4 ;Get the number of switches .IF NE MDUP BEQ 5$ ;No switches is ok for MDUP .ENDC ;NE MDUP BNE 1$ ;Branch if some there ;+ ;ERROR ILCMND: .ERR #ERAREA,#ILC,LEVEL=FATAL,RETURN=NO ; <-F-Invalid command> ;- 1$: CLR R0 ;Clear index MOV #SWTLST,R2 ;Point to the option character table MOV (SP)+,R1 ;Get the option BMI 111$ ;Branch if there was a value CLR -(SP) ; else fake one 111$: CMPB R1,#'a ;Between a and z ? BLO 2$ ;No, branch CMPB R1,#'z ;Between a and z ? BHI 2$ ;No, branch BICB #040,R1 ;Clear bit 2$: MOVB R1,ERROPT ;Save option just in case its Invalid CMPB R1,(R2)+ ;Is this the option? BEQ 3$ ;Branch if so INC R0 ;Bump the index TSTB @R2 ;Any more options there? BNE 2$ ;Branch if so. Try again ;+ ;ERROR MOV #ILO,R1 ;Set up error message ; <-F-Invalid option: /x> ;- BR ILOV1 ;Go give it 3$: ASL R0 ;Make it a word index BIT EXCLST(R0),@FLGTAB(R0) ;Any bits we don't like set? ;+ ;ERROR BNE ILCMND ;Branch if so. Error ; <-F-Invalid command> ;- BIS BITABL(R0),@FLGTAB(R0) ;Set our bit. MOV PROTBL(R0),R3 ;R3 -> option processing routine MOV (SP)+,R0 ;Get the value TST R3 ;Is there a routine to execute? BEQ 4$ ;None. Done for this option JSR PC,@R3 ;Call the routine 4$: SOB R4,1$ ;Count down 5$: MOV R5,-(SP) ;Restore the return address .IF NE MDUP ;If MDUP ASL DIDV ;Shift left one bit BCS 6$ ;Branch if carry set TSTB DOCMND+1 ;are we skipping because /V:N failed? BPL 6$ ;No, it is 0 or +1 SEC .ENDC ;NE MDUP 6$: MOV R0,-(SP) ;Push R0 ROR R0 ;Move carry into high bit of R0 ...CMY ROL R0 ;Restore carry to previous state MOV (SP)+,R0 ;Pop R0 RETURN .DSABL LSB .SBTTL Option processing routines ;+ ; These routines are called by DECODE to complete processing of an ; option. They are generally taking care of any value passed. R4 and ; R5 must not be modified by any of the switch processing routines. ; ; R0 = The value for the switch or 0 ; R1 = The switch ; ; JSR PC,@R3 ; ; R0 - R3 modified ;- .IF NE SDC ;+ ;ERROR ILOV1: .ERR #OEAREA,R1,LEVEL=FATAL,RETURN=NO ; <-F-Invalid option: /x> ;- .IFF ;NE SDC .IF EQ MDUP .SBTTL SEGVAL - Take care of /N .ENABL LSB SEGVAL: TST R1 ;Did user give value? BPL 1$ ;No, ignore option MOV R0,SEGMNT ;Save the number of segments wanted ;+ ;ERROR BEQ ILOVAL ;Zero is not good ; <-F-Invalid option value> ;- CMP #MAXSEG,R0 ;Too many? BGE 1$ ;Branch if not .IFTF ;EQ MDUP ;+ ;ERROR ILOVAL: MOV #IOV,R1 ;Set up the error code ILOV1: .ERR #OEAREA,R1,LEVEL=FATAL,RETURN=NO,ASCII=#ERROPT ; <-F-Invalid option value> ;- .IFT ;EQ MDUP 1$: RETURN .DSABL LSB .IFTF ;EQ MDUP .SBTTL ZERVAL - Take care of /Z .ENABL LSB ZERVAL: TST R1 ;Any value specified? BPL 1$ ;Branch if not ASL R0 ;Make it bytes CMP #MAXBYT,R0 ;Too many? ;+ ;ERROR BLT ILOVAL ;Branch if so ; <-F-Invalid option value> ;- MOV R0,XTRBYT ;Save it 1$: TST INFILE ;*DCL* ;Is there a file? BNE 2$ ;*DCL* ;Branch if so MOV OUTFIL,INFILE ;*DCL* ;Copy the output file MOV OUTFIL+2,INFILE+2 ;*DCL* ;Copy the first word of filenam;002 CLR OUTFIL ;*DCL* ;Get rid of the output file 2$: RETURN .DSABL LSB .IFT ;EQ MDUP .SBTTL VOLVAL - Take care of /V .ENABL LSB VOLVAL: BIC #FL.ONL,$AFLAG ;Reset the flag TST R1 ;Was a value specified? BPL 1$ ;Nope... CMP R0,#<^RONL> ;Yes, is it /V:ONL? ;+ ;ERROR VOLPT:: BNE ILOVAL ;Nope... ; <-F-Invalid option value> ;- BIS #FL.ONL,$AFLAG ;Yes, set the flag again 1$: BIS #FL.VPT,$AFLAG ;Indicate we may wish volid printed BIS #FL.VOL,$MFLAG ; or initialized RETURN .DSABL LSB .SBTTL RETVAL - Take care of /B, /R .ENABL LSB RETVAL: MOV #100000,R2 ;Assume /R:RET CMPB #'R,R1 ;Was it /R? BEQ 1$ ;Branch if so SWAB R2 ; Else indicate /B 1$: TST R1 ;Was a value given? BPL 2$ ;Branch if not CMP #^RRET,R0 ;Was it "RET"? ;+ ;ERROR RETPT:: BNE ILOVAL ;Branch if not... Error ; <-F-Invalid option value> ;- BIS R2,RETAIN ;Set the "RET" flag 2$: RETURN .DSABL LSB .IFTF ;EQ MDUP .SBTTL EXTVAL - Take care of /T .ENABL LSB EXTVAL: TST R1 ;Was a value given? BMI 1$ ;Branch if so ;+ ;ERROR ILCMD1: JMP ILCMND ; Else it's an error ; <-F-Invalid command> ;- 1$: MOV R0,EXTSIZ ;Save the size RETURN .DSABL LSB .IFT ;EQ MDUP .SBTTL UNIFIX - Take care of /D UNIFIX: TST INFILE ;*DCL* ;Is there a file? BNE 1$ ;*DCL* ;Branch if so MOV OUTFIL,INFILE ;*DCL* ;Copy the output file CLR OUTFIL ;*DCL* ;Get rid of the output file 1$: RETURN .SBTTL STRVAL - Take care of /G STRVAL: TST R1 ;Was a value given? BPL 2$ ;Branch if not BIC #100000,R1 ;Clear the high bit SWAB R1 ;Make the file number low CMPB R1,#3 ;Was it input or output BLT 1$ ;Branch if output MOV R0,REDSTR ;Save the read start block BR 2$ ; 1$: MOV R0,WRTSTR ;Save the write start address 2$: RETURN .SBTTL ENDVAL - Take care of /E ENDVAL: TST R1 ;Was a value given? BPL 1$ ;Branch if not MOV R0,REDEND ;Save as read stop block MOV #1,REDSW ;Indicate that /END was given ;003 1$: RETURN .SBTTL SQUINI - Take care of /S SQUINI: TST OUTFIL ;Was an output file specified? BNE 1$ ;Branch if so MOV INFILE,OUTFIL ;Copy input to output 1$: TST INFILE ;Was an input file specified? BNE 2$ ;Branch if so MOV OUTFIL,INFILE ;Copy output to input 2$: RETURN .SBTTL BOOFL - Take care of /U ;+ ; This routine takes care of any value passed by the /U switch. It will ; be used by WBOOT as the filename of the handler file whose bootstrap ; is being written on a foreign device; ie ; ; PD bootstrap written on DX system ; PD bootstrap written on DD system ; DX bootstrap written on DY system ;- BOOFL: MOV R0,BOOWHO ;Save the value MOV #50,R1 ;Check for an Invalid value CALL $DIV ; by getting the last character TST R1 ;Was there one? (Test the remainder) ;+ ;ERROR BNE ILOVAL ;Yes. No good ; <-F-Invalid option value> ;- RETURN .IFF ;EQ MDUP .SBTTL BLDFIX - Take care of /H ;+ ; This routine forces the user to re-RUN MDUP to build the next MDUP.Mx file ; because the code is not necessarily pure. It does this by turning the ; /H option to a / which is Invalid to CSI. ;- BLDFIX: MOVB #BLANK,-(R2) ;Modify the switch RETURN .ENABL LSB .SBTTL VMSWIT - Take care of /V VMSWIT: MOV R4,-(SP) ;Save R4 MOV R5,-(SP) ;Save R5 MOV #100000,DIDV ; Set high bit TST R0 ; Value passed ? BNE 9$ ; Yes, branch CLRB DOCMND+1 ; Set flag 0 JMP 12$ ; Jump ; This is the test for enough extra memory 9$: MOV #1600,R1 ;R1 = base # of chunks ASL R0 ;MULT. BY 2. ASL R0 ;MULT. BY 4. ASL R0 ;MULT. BY 8. ADD R1,R0 ;R0 = memory that we're testig for MOV R0,TRUVM ;Save value in TRUVM ;;; .TRPSET #IOAREA,#SETCAR ;Catch trap to 4 and 10 's MOV @#V.TRP4,-(SP) ;save old trap4 address MOV @#V.TRP4+2,-(SP) ;and PS value MOV #SETCAR,@#V.TRP4 ;plug in ours MOV #PR7,@#V.TRP4+2 ; ... TST @#SR0 NOP BCS 11$ BIS #20,@#SR3 ;+ ; Initialize memory management. ;- MOV #PMODE+PR7,@#PS ;Go to kernel mode, set previous = user MOV #KISAR0,R3 ;R3->KERNEL I - Space addr register 0 (PAR 0) MOV #KISDR0,R1 ;R1->KERNEL I - Space descriptor reg 0 (PDR 0) MOV #UISAR0,R2 ;R2->USER I - Space address register 0 (PAR 0) MOV #UISDR0,R0 ;R0->USER I - Space descriptor reg 0 (PDR 0) MOV R4,-(SP) ;Save memory size for FB MOV #8.,R4 ;R4 = counter CLR R5 ;Start at 0 20$: MOV R5,(R3)+ ;Set KERNEL PAR MOV R5,(R2)+ ;and USER PAR MOV #AP$ACF,@R1 ;Set 4K with no system trap/abort action MOV (R1)+,(R0)+ ;and USER PDR ADD #200,R5 ;Bump to next 4K SOB R4,20$ ;Loop until all 8 sets done. MOV #177600,-(R3) ;Make KERNEL PAR7 -> I/O page MOV @R3,-(R2) ;Same for USER PAR 7 INC @#SR0 ;Turn on the KT-11 ;+ ; Now size memory into 32 word blocks ;- MOV #V.MPTY,R0 ;Point to memory parity trap vector MOV @R0,-(SP) ;Save old PC MOV ANRTI,(R0)+ ;Point to an RTI MOV @R0,-(SP) ;Save old PS MOV #PR7,(R0)+ ;Kernel mode at priority 7 MOV #KISAR1,R3 MOV #1000,(R3) ;Set up PAR6 to start of 16K boundary. 30$: MOV #20000,R0 ;Start of PAR1. MOV @#0,-(SP) ;Save physical location 0 COM @R0 ;Complement location 0 in current page MOV @#0,-(SP) ;Save physical location 0 again COM @R0 ;Restore location 0 of current page CMP (SP)+,(SP)+ ;Did physical location 0 change? BNE 50$ ;Branch if it did -- we have wrap-around CLC ;Make sure C-bit is cleared for next move inst 40$: MOV @R0,R4 ;Try to read the memory MOV R4,(R0)+ ;Write the memory with good parity BCS 50$ ;C-bit is set if memory is non-existent or ROM CMP #24000,R0 ;Done clearing? BHI 40$ ;No, continue clearing ADD #40,@R3 ;and adjust the map register CMP @R3,(PC)+ ;End of memory? CHKLIM: .WORD 177600 ;Assume 22-bit system BLO 30$ ;No, there is more - branch 50$: MOV #V.MPTY+4,R0 ;Point to memory parity trap vector + 4 MOV (SP)+,-(R0) ;Restore old PS MOV (SP)+,-(R0) ;Restore old PC MOV (SP)+,R4 ;Restore memory size for FB ;+ ; Memory size found ;- MOV @R3,R2 ;Store memory size (/32 words) in R2 CLR @#SR0 ;Turn off memory management CLR @#PS ;back to priority 0 ; here check size CMP TRUVM,R2 ;Is there enough VM ? BHI 10$ ;No. branch MOV #400+1,DOCMND ; Set flag in low and high byte ;;; .TRPSET #IOAREA,#0 ;Reset trap catching BR 11$ MPERR: RTI ;Just return on memory parity errors 10$: MOV #377*400+001,DOCMND ;Set flag negative in high and 1 low byte ;+ ;ERROR .ERR #ERAREA,#NAI,LEVEL=FATAL,RETURN=YES ; <-F-Insufficient memory, bypassing automatic installation> ;- 11$: MOV (SP)+,@#V.TRP4+2; Restore old PS value MOV (SP)+,@#V.TRP4 ; Restore old trap 4 address 12$: MOV (SP)+,R5 ;Restore R5 MOV (SP)+,R4 ;Restore R4 RETURN SETCAR:: ;;; .TRPSET #IOAREA,#SETCAR ;Catch trap to 4 and 10 's BIS #1,2(SP) ;Set bit ANRTI: RTI .DSABL LSB .ENDC ;EQ MDUP .ENDC ;NE SDC .SBTTL DEFALT - Default value setup ;+ ; DEFALT ; This routine processes some of the default values for options and does ; some more command line validation. ; ; JSR PC,DEFALT ; ; R0,R5 modified ;- DEFALT:: .IF NE IND CALL APPRMT ;Put in prompts for /WAIT with IND .ENDC ;NE IND MOV #$AFLAG,R5 ;R5 -> action flag word .IF EQ ; *** Begin Critical Ordering *** 11$: BIT #FL.UNI,@R5 ;/RESTORE (/D) specified? BEQ 1$ ;Nope... BIC #FL.ZRO,@R5 ;Yes, disable volume initialization 1$: BIT #FL.ZRO,@R5 ;Volume initialization requested? BEQ 2$ ;Nope... BIC #FL.VPT,@R5 ;Yes, disable volume print 2$: BIT #FL.VPT,@R5 ;Print volume ID? BEQ 25$ ;Nope... BIC #FL.ONL,@R5 ;Yes, then :ONLY is superfluous 25$: BIT #FL.ONL,@R5 ;Was /VOLUME:ONLY (/V:ONL) specified? BEQ 3$ ;Nope... BIC #FL.ZRO,@R5 ;Yes, disable volume initialization ; *** End Critical Ordering *** .IFTF ;EQ 3$: TST @R5 ;Any action to do? .IFT ;EQ BNE 5$ ;Branch if so. Good command, so far ;+ ;ERROR 4$: .ERR #ERAREA,#ILC,LEVEL=FATAL,RETURN=NO ; <-F-Invalid command> ;- .IFF ;EQ .IF EQ SDC BNE 8$ ;Branch if so. Must be /Z ;007 MOV #FL.COP,@R5 ;Else do the default (copy and boot syst;**-1 .ENDC ;EQ SDC .IFT ;EQ 5$: BIT #FL.IMA,$AFLAG ;/I? BEQ 6$ ;Branch if not CMP REDSTR,REDEND ;/G input value > /E value? BHI 4$ ;Branch if so. That's not good 6$: BIT #FL.CRE,$AFLAG ;CREATE? BEQ 8$ ;Branch if not TST OUTFIL+10 ;Size specified? BNE 7$ ;Branch if so MOV #CMDBUF,R1 ;R1 -> Command line ;006 64$: CMPB (R1),#133 ;Is it a "["? ;006 BEQ 7$ ;Yes - he really wants 0 ;006 TSTB (R1)+ ;End of command line? ;006 BEQ 65$ ;Yes - make it 1 ;006 BR 64$ ;Check next byte ;006 65$: INC OUTFIL+10 ;Else make it 1 ;006 7$: TST WRTSTR ;Start value given? BNE 8$ ;Branch if so MOV REDSTR,WRTSTR ;Use the other /G value. May be 0 .ENDC ;EQ ;007 8$: RETURN ;004 .SBTTL Prompts for /WAIT with IND ;005 ;+ ;005 ; This routine inserts 3 user specified prompts into the strings ;005 ; which are used for prompts when /WAIT is specified. It also saves ; strings which are the volume IDs of the 3 volumes involved. The ; input consists of a file, AP.TMP which contains 6 lines: ; Input prompt ; Input volume ID ; Output prompt ; Output volume ID ; System prompt ; System volume ID ; The prompts will be inserted into the prompts in this format: ;005 ; Mount in DX1:; Continue? ;005 ; TEXT is a string such as 'Autopatch volume 1'. ;005 ; If an asterisk is specified in place of one of the strings, ;005 ; the prompt for that volume will not be issued. In that case it ;005 ; is assumed that the volume is already mounted. ;005 ;- .IF NE IND ;005 APPRMT:: ;005 MOV #$MFLAG,R5 ;Options flag ;005 BIT #FL.WAT,@R5 ;Doing /WAIT? ;005 BEQ 3$ ;Branch if not ;005 .LOOKUP #IOAREA,ACHAN,#APTMP ;Lookup AP.TMP ;005 BCC 1$ ;Branch if no error ;005 ;+ ;ERROR .ERR #ERAREA,#FE.FNF,LEVEL=FATAL,RETURN=NO,FILE=#APTMP ;005 ; <-F-File not found: AP.TMP> ;005 ;- 1$: .READW #IOAREA,ACHAN,#APIN,APSZ,APBLK ;Read the text ;005 BCC 2$ ;Branch if no error ;005 ;+ ;ERROR .ERR #ERAREA,#FE.INE,LEVEL=FATAL,RETURN=NO,FILE=#APTMP ;005 ; <-F-Input error: AP.TMP> ;005 ;- 2$: .CLOSE ACHAN ;Close AP channel ;005 MOV #WAITIN,R1 ;R1 -> Input volume prompt ;012 MOV #APIN,R2 ;R2 -> Text from AP.TMP ;012 CALL GETSTR ;Save the input volume prompt MOVB #200,(R1) ;Insert a <200> MOV #WTINVL,R1 ;R1 -> Input volid string CALL GETSTR ;Save the input volid string MOV #WAITOUT,R1 ;R1 -> Output volume prompt CALL GETSTR ;Save the output volume prompt MOVB #200,(R1) ;Insert a <200> MOV #WTOUVL,R1 ;R1 -> Output volid string CALL GETSTR ;Save the output volid string MOV #WAITSY,R1 ;R1 -> System volume prompt CALL GETSTR ;Save the system volume prompt MOVB #200,(R1) ;Insert a <200> MOV #WTSYVL,R1 ;R1 -> System volid string CALL GETSTR ;Save the system volid string 3$: RETURN ;012 .SBTTL - GETSTR - Get a string for the IND prompts ;+ ; GETSTR ; This procedure moves one string (up to a CR) into a buffer. ; ; INPUT: ; R2 -> source ; R1 -> destination ;- GETSTR: 1$: CMPB (R2),#15 ;Is it a CR? BEQ 2$ ;Branch if it is MOVB (R2)+,(R1)+ ;Move a byte to prompt BR 1$ ;Get next byte 2$: TSTB (R2)+ ;Skip the CR TSTB (R2)+ ; and the LF RETURN .ENDC ;.IF NE IND ;012 .SBTTL INITDM - Initialize dynamic memory ;+ ; INITDM ; This routine sets up the dynamic memory list head. It is used so that ; the equivalent routine in the utilities library will be placed in the ; overlay, rather than the root. ; ; JSR PC,INITDM ; ; R0 = size of free memory ;- INITDM:: MOV R1,-(SP) ;Preserve R1 MOV #FREMLH,R1 ;R1 -> free memory list head MOV @#S$HLMT,@R1 ;Set up the first word of free space ADD #2,@R1 ;Bump it past us .IF EQ .GVAL #IOAREA,#S.USRL ;R0 = USR load address TST -(R0) ; - 2 CMP R0,@R1 ;Are we already above the USR? BLOS 1$ ;Branch if so. Take all memory and swap USR MOV @R1,-(SP) ;PUT CURRENT TOP ON STACK ADD #MX.MEM,@SP ;ADD IT THE MINIMUM REQUIRED CMP R0,(SP)+ ;WILL THIS BE enough memory? BHIS 2$ ;Branch if at least enough .ENDC ;EQ 1$: MOV #-2,R0 ;Else ask for everything 2$: .SETTOP ;Request the memory SUB @R1,R0 ;Get the size of dynamic memory MOV @R1,R1 ;R1 -> first block of memory CLR (R1)+ ;No link to next BIC #3,R0 ;Down to a 4 byte boundary MOV R0,@R1 ;Save the size MOV (SP)+,R1 ;Restore R1 RETURN .END