.MCALL .MODULE .MODULE LD,VERSION=64,COMMENT= ; 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. ;++ ; Facility: RT-11 LOGICAL DISK HANDLER ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 15-JAN-90 Check file protection status ; before invoking .FProt ; If the file is already protected, ; don't try to protect again just ; in case the mass storage device ; is physically write-protected. ; This precaution prevents an ; unnecessary warning message about ; failing to protect the file with ; .FProt ; Also, the EMT argument block for ; .FProt got extended by one word ; containing the constant PHYSICAL. ; This is a V5.5 requirement if ; no logical name translation for the ; file specification is to be performed. ; 002 WLD 29-NOV-90 Eliminated FBMON$. If SJONLY = 1, ; LD will not install if the number ; of jobs supported is not exactly one. ; 003 WLD 19-DEC-90 A decision has been made to eliminate ; the SJONLY flag for v5.6 ; Implemented in this fix. ; 064 WFG 19-Jun-91 ACTION #7479, Remove AUDIT=YES from ; .MODULE line so .AUDIT will work ;-- .SbTtl Conditional assembly summary ;+ ;COND ; ; LD$OWN (1) OWNER enforcement ; LD$OWN (0) OWNER enforcement ; 0 ignore ownership (bypass it) ; 1 enforce ownership ; ; ; LD$NAM (^rLD ) handler name ; ; EIS$I (RTE$M!MMG$T) use SOB instruction ; 0 simulate SOB ; 1 use SOB ; ; DEF$LD (^rDSK) default extension for logical disk files ; ; RTE$M (0) RTEM version (just affects message prefix ; and install code) ; 0 not RTEM version ; 1 RTEM version ; ; MMG$T (0) std conditional ; LD$N64 (0) ; TIM$IT std conditional (no code effects) ; ERL$G std conditional (no code effects) ; ; INTERNAL CONDITIONALS ; ; LD$PMU min(LD$UNI,32.) the number of units possibly mountable ; used by SET LD EMPTY command ;- .SbTtl PSECT ordering .PSect LdDvr .PSect SetOvr .PSect LdRun .PSect .LibC. .NList BEX,CND .IIf NDF LD$N64, LD$N64=0 ; ASSUME 8 UNIT LD .IIf NE LD$N64, LD$N64=1 ; EITHER 0 OR 1 ONLY .IIf NDF LD$UNI, LD$UNI=8.*LD$N64+8. ; ASSUME 8 OR 16 UNITS .IIf GT LD$UNI-64., LD$UNI=64. ; 64 UNITS MAXIMUM .IIf LT LD$UNI-8., LD$UNI=8. ; 8 UNITS MINIMUM .IIf EQ LD$N64, LD$UNI=8. ; 8 UNITS MAXIMUM W/O 64-UNIT LD$PMU=LD$UNI .IIf GT LD$PMU-32., LD$PMU=32. ; 32 MAXIMUM MOUNTABLE UNITS .IIf NDF RTE$M RTE$M=0 ; Assume not RTEM .IIf NDF MMg$t MMg$t=0 ; Assume not supporting XM systems .IIf NDF LD$Own LD$Own=1 ; Assume support for ownership testing .IIf NE LD$Own LD$Own=1 .IIf NDF LD$Nam LD$Nam=^rLD ; Assume handler name is LD .IIf NDF EIS$I EIS$I=RTE$M!MMg$t ; Assume EIS not available ; unless RTEM or XM .IIf NE MMg$t&RTE$M .Error ; Can not be XM and RTEM; .IIf NDF Def$LD Def$LD=:^rDSK ; default extension .LDGen =: <2*MMg$t>!<10*RTE$M>!<400*EIS$I>!<2000*LD$Own> .Audit .LD .LDGen Def$LD .SbTtl .If NE MMg$t .SbTtl LDX is handler name .IfF ; NE MMg$t .If EQ RTE$M .SbTtl LD is handler name .IfF ;EQ RTE$M .SbTtl *** Supports RTEM .SbTtl LDM is handler name .EndC;EQ RTE$M .EndC ; NE MMg$t .If EQ LD$Own .SbTtl Device ownership is NOT checked .IfF ; EQ LD$Own .SbTtl Device ownership IS checked .EndC ; EQ LD$Own .SbTtl .SbTtl Macros and Definitions .MCall .DrDef ; normal handler macro .MCall .CsiSpc .Print .Exit .Purge ; other macros .MCall .LookUp .DStat .FProt .Fetch .MCall .Enter .SpFun .WritW .CStat .MCall .Release .SErr .Chain .SetTop .MCall .SReset .Assume .Br ...CmZ .MCall .Addr .CkXX .MCall .GFSta .IIf EQ EIS$I .MCall SOB .CkXX .CkXX .CkXX .CkXX .CkXX .CkXX .CkXX CkUnit =: 3 ; unit number for CK.__ CkUBuf =: 10000 ; user Buffer addr for CK.__ CkSP =: 1000 ; SP value for CK.__ CkFlag =: CkSP-2 ; SP-2 value for CK.__ CkCurr =: 3003 ; current entry for CK.__ CkNUnit =: 5 ; new unit number for CK.__ CkFile =: 6 ; CSI file number CkIndx =: 13 ; index value for CK.__ CkJunk =: 123456 ; "Trash" value for CK.__ .SbTtl Global References to ULBLIB .Globl $CBOMg ; convert unsigned binary to Ascii(8) .Globl $FnAsc ; convert Rad50 DBlk to Ascii filename .Globl $R50Asc ; convert Rad50 word to Ascii ; $R50Asc is combined with $FnAsc ; The ULBLIB rather than SYSLIB version ; These equates and the $Rel macro are used to provide "self" relocation ; of addresses based on LD and based on RMON. LD.Cnt = 0 ; LD relocation counter RM.Cnt = 0 ; RMON relocation counter ;+ ; $REL ; ; Used to mark words to relocate in the handler ; ; $Rel Loc Value Base ; ; Loc -- location of word to relocate ; Value -- value to relocate it to ; Base -- base relocation on (LD or RMON) ;- .Macro $Rel Loc Value Base ...V2 = . . = Loc .If IDN Ld.Cnt = Ld.Cnt+1 .Irp ...V3 <\Ld.Cnt> LD.'...V3: .Word Value-LdBase .EndR . = ...V2 .MExit .EndC .If IDN RM.Cnt = RM.Cnt+1 .Irp ...V3 <\RM.Cnt> RM.'...V3: .Word Value .EndR . = ...V2 .MExit .EndC .Error ; Unknown B A S E "Base"; .EndM $Rel ;+ ; BOFF ; ; Used to define mnemonic branch after TST(B)/BIT(B) ; ; Boff Dst ; ; Dst -- location to branch to if bit/byte/word off (zero) ;- .Macro Boff Dst Beq Dst .EndM Boff ;+ ; BON ; ; Used to define mnemonic branch after TST(B)/BIT(B) ; ; Bon Dst ; ; Dst -- location to branch to if bit/byte/word on (non-zero) ;- .Macro Bon Dst ; Mnemonic Branch after TST/BIT Bne Dst .EndM Bon ;+ ; ...... ; ; indicate unconditional "branching" ; ; ...... ;- .Macro ...... .EndM ...... .SbTtl Equates ; Hardware references PR7 =: 7*40 ; PS priority 7 value ; SYSCOM references JSP =: 42 ; original stack pointer value JSW =: 44 ; Job Status Word SpXit$ =: 40 ; command to KMON w/o breaking .COMs Chain$ =: 400 ; chained-to bit Ovly$ =: 1000 ; overlaid program ChnIF$ =: 4000 ; command in chain area for KMON RStrt$ =: 20000 ; Restart allowed JUsErB =: 53 ; User error byte Succs$ =: 1 ; error level bit code Warn$ =: 2 Error$ =: 4 Fatal$ =: 10 Uncon$ =: 20 JRMon =: 54 ; pointer to RMON $CSW =: 4 $PNPTR =: 404 ; Handler block 0 references InsCsr =: 176 ; installation CSR value InsCk =: 200 ; Installation code ; Chain area references CmdLen =: 510 ; command length word for KMON CmdStr =: 512 ; command string for KMON ChnTo =: 500 ; program to chain to (us) PPN =: 510 ; RSTS PPN ChnFrm =: 512 ; program chained from (return to) ; 0 == EXIT ChnArg =: 522 ; Asciz command string ChnNon =: 377 ; 377 implies none. ChnRtn =: 177 ; 177 implies return ChnErr =: 523 ; on return, error number **BYTE** ChnUEB =: 524 ; on return, equivalent user error **BYTE** ChnMsg =: 525 ; on return, message or null ChnEOL =: -1 ; local end of command ; RMON references Indx$M =: 76 ; mask for device index in CSW SyUnit =: 275 ; system booted from unit **BYTE** SysVer =: 276 ; offset to version byte MinVer =: 5 ; minimum version to install under ConFg1 =: 300 ; first configuration word $MTPS =: 360 ; Move to PS routine [MTPS (SP)+] $MFPS =: 362 ; Move from PS routine [MFPS -(SP)] SyIndx =: 364 ; handler index number of system device ConFg2 =: 370 ; offset to 2nd config word LDRel$ =: 000020 ; .Release / $UNLOAD bit SysGen =: 372 ; offset to SysGen word XMMon$ =: 000002 ; XM monitor RTEM$ =: 000010 ; RTEM monitor $PName =: 404 ; $PName device name table MaxSlt =: 31. ; Maximum number of entries ($Slot) EntEnd =: 177777 ; indicator for end of $ENTRY Suffix =: 412 ; Suffix for device handler files OwnMsk =: 17 ; mask for unit in $OWNER table $Jobs =: 455 ; number of jobs supported Cnfg3 =: 466 ; offset to 3rd config word Cf3.64 =: 000400 ; 64-unit monitor support bit Cf3.Ow =: 002000 ; ownership support bit ; Misc definitions Odd =: 1 ; bit used to set/clear/test oddness LOmask =: 7 ; Mask to extract bits <2:0> HImask =: 160 ; Mask to extract bits <6:4> SPFBAS =: 360 ; Offset to form "real" SPFUN code MSK345 =: 70 ; Mask to test bits <5:3> of a byte UntMsk =: ^o77 ; Mask to isolate valid unit # (0-77) OctMsk =: 7 ; mask for an octal digit Unit8 =: 8. ; 8 units in 8-unit monitor Unit64 =: 64. ; 64 units in 64-unit monitor Bin2As =: '0 ; convert 0--9 bin to 0--9 ascii LC2UC =: 040 ; convert a--z ascii to A--Z (BIC) Space =: <' > ; Space character LC.a =: 'a ; Lowercase a LC.z =: 'z ; Lowercase z Bn2Rd1 =: <^r 0> ; convert 0--9 bin to 0--9 rad50 Bn2Rd2 =: <^r 0 > ; convert 0x--9x bin to 0x--9x rad50 WdsBlk =: 256. ; words in a standard disk block JobMsk =: 7 ; mask for job number bits FilNum =: 17 ; mask for file number in CSI ; option return ; Define .SpFun Codes Upd$Fn =: 372 ; update request for LD handler Siz$Fn =: 373 ; device size request ; ; all other SPFUN codes are IGNORED Swt.$ =: '$ ; DCL option Swt.A =: 'A ; Assign option Swt.C =: 'C ; Clean option Swt.E =: 'E ; Empty option Swt.L =: 'L ; Logical unit (mount) option Swt.R =: 'R ; Read Only option Swt.W =: 'W ; Write option .SbTtl Define handler characteristics .IF EQ LD$N64 .DrDef LD, 46, FilSt$!SpFun$!VarSz$, 0, 0, 0,DMA=NO .DrPtr FETCH=INIT,LOAD=INIT .IFF ;EQ LD$N64 .DrDef LD, 46, FilSt$!SpFun$!VarSz$, 0, 0, 0, UNIT64=YES,DMA=NO .DrPtr FETCH=INIT,LOAD=INIT,UNLOAD=UNL$64,RELEASE=UNL$64 .ENDC ;EQ LD$N64 .DrESt CLASS=DVC.DK,DATA=LDData,TYPE=LD .DRSpF ; update request for LD handler .DRSpF ; device size request .Asect ; stuff for first block ;********************************************************************** HS2.MO =: 20 H.STS2 =: 36 .=H.STS2 .WORD HS2.MO ;********************************************************************** .=:JSW .Word Ovly$ ; get system to leave chan 17 open .SbTtl Installation check code .DrIns LD Br 10$ ; non-system device ........... .Assume . EQ InsSys Br InErr ; system device, illegal ............. 10$: Mov @#JRmon, R0 ; get RMon address CK.R0=JRmon CK.R0 JRmon CmpB SysVer(R0),#MinVer ; is this new enough version? Blo InErr ; no, then do not allow Bit #RTEM$,SysGen(R0) ; running under RTEM? .If NE RTE$M ; supporting RTEM only? Boff InErr ; No, it is not RTEM, can't support .IfF ;NE RTE$M Bon InErr ; No, it is RTEM, can't support .EndC ;NE RTE$M CK.R0 JRmon Bit #XMMon$,SysGen(R0) ; running under XM? .If NE MMG$T ; supporting XM only? Boff InErr ; No, it is SJ or FB, can't support .IfF ;NE MMG$T Bon InErr ; No, it is XM, can't support .EndC ;NE MMG$T Tst (PC)+ ; clear Carry, skip Sec InErr: ; installation error Sec ; error, do not install Return ...... ;+ ; DoChain ; ; This routine generates the data required to chain to LD and ; appends the command pointed to by R3, up to a -1 word. ; It then does a .CHAIN. ; ; Jsr R3,DoChain ; .Ascii "command" ; .Even ; .Word -1 ;- .Enable LSB DoChain: Mov @#JRMON,R0 ; R0 -> start of rmon CK.R0=JRmon CK.R0 JRmon Add SUFFIX(R0),RNAME ; Add in the suffix Jsr R1,10$ ; point to prefix part .Rad50 "SY " RName: .RMODULE .Rad50 " SYS" .Word 0 ; RSTS PPN .Word 0,0,0,0 ; chained to pgm to do exit .Word ChnEOL ; end of list 10$: Mov #ChnTo,R0 ; point to chain area ABS 20$: Mov @R1,(R0)+ ; move to chain area Cmp #ChnEOL,(R1)+ ; end of list? Bne 20$ ; until it is found Tst -(R0) ; backup over terminator (-1) 30$: Mov @R3,(R0)+ ; move to chain area Cmp #ChnEOL,(R3)+ ; end of list? Bne 30$ ; until it is found .Chain ; and chain to setup program ...... .Dsabl LSB .Assume . LE 400,MESSAGE=<;Install area overflow> .SbTtl Set Code .Enable LSB ;R1 is unit number (from SET code) ; Option data routine syntax ; ------ ------ ------- ------ .DrSet CLEAN Swt.C SetCle .DrSet EMPTY -1 SetMty .DrSet WRITE Swt.R SetWri NO .DrSet BPT NOP SetBPT ; R0 used ; R3 data from SET code SetBPT: ; SET LD[x] BPT=n Mov #BPT,R3 ; put in a BPT .Br SetNoB SetNoB: ; SET LD[x] NOBPT=n .Assume SetBPT+4 EQ SetNoB Cmp #BPTLen/2,R0 ; value in range? Blos SetErr ; no, error return (unsigned test) Asl R0 ; make into word index CK.SP=CkSP CK.SP ,-2 Jsr R1,10$ ; point to table PIC BPTTab: .Word DBGSet-BPTTab ; SET LD [NO]BPT=0 ! debug SET code .Word DBGQue-BPTTab ; SET LD [NO]BPT=1 ! debug QUEUE code ; Patch NOP to debug INIT code ; Patch NOP to debug LDRUN code BPTLen =: .-BPTTab 10$: Add R1,R0 ; PIC Mov @R0,R0 ; get offset Add R1,R0 ; and make into address PIC Mov R3,@R0 ; change location to BPT/NOP CK.SP ,+2 Mov (SP)+,R1 ; restore stack/R1 CK.SP CkSP Br SetOk ; normal return ............. SetWri: ; SET LDx WRITE Mov #Swt.W,R3 ; use the write option .Br SetNoW SetNoW: ; SET LDx NOWRITE .Assume SetWri+4 EQ SetNoW .Br SetCle ; join common code ; R0 used ; R1 is unit number (LDx) from SET code ; R3 is option letter from SET data (or MOV) ; R5 is pointer into command buffer from SET code ; SET LDx CLEAN SetCle: Call DBGSet ; possible debug TstB -1(R5) ; only one option? Bne Not1Op ; more than 1 option MovB R3,Letter ; put option letter in buffer Mov R1,R0 ; copy number Bic #^cOctMsk,R1 ; isolate low octal digit Add #Bin2As,R1 ; make low octal digit into ascii Asr R0 ; isolate Asr R0 ; high Asr R0 ; octal Bic #^cOctMsk,R0 ; digit Add #Bin2As,R0 ; make high octal digit into ascii MovB R0,Number ; put high digit in the buffer MovB R1,Number+1 ; put low digit in the buffer Jsr R3,DoChain ; point to info PIC .............. .Assume . EQ 20$ 20$: .Ascii "/" Letter: .BlkB 1 ; option letter .Ascii ":" Number: .BlkB 2 ; option value .Asciz "" .Even .Word ChnEOL ; end of list SetMty: Call DBGSet ; possible debug TstB -1(R5) ; only one option? Bne Not1Op ; more than 1 option Jsr R3,DoChain ; point to list .Asciz "/E" .Even .Word ChnEOL ; end of list .Enable LSB Not1Op: ; too many options CK.SP=CkSP CK.SP ,-2 ;+ ;ERROR Jsr R0,SetMsg ; point to message PIC ................. .Ascii "?" .NLCsi TYPE=I,PART=NAME .Asciz "-F-Only 1 option per SET allowed" ; ; More than 1 option specified in the same SET LDn command. ; Retry is to specify 1 option per SET. ; Example: BAD-- SET LD3 CLEAN,NOWRITE ; Example: GOOD-- SET LD3 CLEAN ; SET LD3 NOWRITE ;- .Even SetMsg: ; do error message from SET code 10$: ; dump rest of command buffer TstB -(R5) ; move back a char TstB -1(R5) ; end of buffer? Bne 10$ ; no, keep going .Print ; print the error message ;;;??? Cmp (SP)+,(SP)+ ; dump return addresses CK.SP ,+2 Tst (SP)+ ; dump return address ;;;??? Set error byte? CK.SP CkSP .Br SetOk ; do not cause KMON error message too SetOk: Tst (PC)+ ; normal return (CLC) SetErr: Sec ; return error Return ; back to KMON set code ...... ; DBGSet: ;5 check for debugging SET code ;***************************************;5 next instruction put over NOP by BPT ;5 SET LD BPT=0 .=:DBGSet;******************************;5 NOP ;5 ;*************************************** Return ...... .Assume . LE 1000,MESSAGE=<;Set area overflow> LDHand =: 1000 ; normal load address .SbTtl Queue Manager code ; Register contents on entry: ; R0 -- ??? ; R1 -- ??? ; R2 -- ??? ; R3 -- ??? ; R4 -- ??? ; R5 -- ??? ; @SP -- normal return ; <@SP>+2 -- requeue return ; ; Register contents on requeue return ; R0 -- as it was on entry ; R1 -- ??? ; R2 -- address of new handler ; R3 -- as it was on entry ; R4 -- address of queue element ; R5 -- ??? ; .Enable LSB .DrBeg LD,LDTBL=LDDATA ; Queue manager entry LdBase =:LDSTRT+6 ; base for LD relocation JMP CONT ............ .SbTtl Data Area LdData:: ; data area BufLow: ; beginning of buffer area .RAD50 "LD" ; LD table format indicator .Word LD$UNI ; number of entries on tables Handlr: .BlkW LD$UNI ; 1 word per unit -- flags and indices H.Leng =: 2 ; length of an entry Handlz: ; just past end of Handlr table Ld.Act =: 100000 ; this unit is allocated Ld.RdO =: 040000 ; this unit is read only Ld$Unt =: 037400 ; unit number mask Ld.UOf =: 000200 ; offset value is wrong Ld.UNx =: 000100 ; index value may be wrong Ld$Ndx =: 000076 ; index number mask Offset: .BlkW LD$UNI ; offset from beginning of device Size: .BlkW LD$UNI ; size of logical disk Name: .BlkW LD$UNI*4 ; RAD50 dblocks for units BufHi: ; end of buffer area H2B =: /2 ; move from handler to buffer B2H =: /2 ; move from buffer to handler $LOT.2: .BLKW 1 ; Value of $SLOT*2 ; ID: ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; | RAD50 "LD_" | 1 instance ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; ; Entry Count ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; | | 1 instance ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; ; Handlr: ; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ ; |A|R| Unit | |O|I| Index | instances ; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ ; ; A == Allocated (1 = defined, 0 = free) ; R == Readonly (1 = readonly, 0 = read/write) ; I == Index may be wrong ; O == Offset is wrong ; Unit == output unit number ; Index == index into handler tables on RMON for this device ; ; Offset: ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; | Offset | instances ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; ; Offset == number of blocks from beginning of "Real" ; disk to beginning of "Subset" disk. ; ; Size: ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; | Size | instances ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ ; ; Size == number of blocks in "Subset" disk. ; ; Name: ; +--------+ +----------------+ +--------+ ; | Dev | | Filename | | Type | instances ; +--------+ +----------------+ +--------+ ; ; Dev -- device name in Rad50 (MUST be handler name, NOT ; logical name, NO unit number) (e.g. DL RK) ; Filename -- filename in Rad50 ; Type -- file type in Rad 50 .SBTTL COPYTO ; Copy words between LD table and user buffer ;+ ; FUNCTION: ; Copy words between LD table and user buffer ; ; AT ENTRY: ; R1: Count of words to be moved ; R2: Ptr to user buffer (SJ/FB) ; R4: Ptr to QEL ; Q$Buff(R4): Ptr to user buffer (XM) ; R5: Ptr to handler's LD table ;- .Enabl LSB COPYTO: Mov R1,-(SP) .If NE MMG$T Asl R1 ; Convert word count to byte count .IfTF ;NE MMG$T Tst Q$WCnt(R4) Bmi 20$ .IfF ;NE MMG$T ; Copy data from handler to User: 10$: Mov (R5)+,(R2)+ ; copy a word Sob R1,10$ ; count and continue until all moved Br CopRet ; finished .............. ; Copy data from User to Handler: 20$: Mov (R2)+,(R5)+ ; copy a word Sob R1,20$ ; count and continue until all moved .IfT ;NE MMG$T ; Copy data from handler to User: 10$: MovB (R5)+,-(SP) ; Push byte from handler buffer ; on stack Call @$PtByt ; pass it thru MMG routine Sob R1,10$ ; move all bytes Br CopRet ; finished .............. ; Copy data from User to Handler: 20$: Call @$GtByt ; get a byte from User buffer ; via MMG routine MovB (SP)+,(R5)+ ; put in handler Sob R1,20$ ; move all bytes .EndC ;NE MMG$T Br CopRet ; finished .............. .Dsabl LSB .SBTTL COPY2 ; Adjust for header and COPYTO ;+ ; FUNCTION: ; Copy words between LD table and user buffer after ; adjusting appropriately for table header ; ; AT ENTRY: ; R1: Count of words to be moved ; R2: Ptr to user buffer (SJ/FB) ; R4: Ptr to QEL ; Q$Buff(R4): Ptr to user buffer (XM) ; R5: Ptr to handler's LD table ;- .Enabl LSB COPY2: Mov R1,-(SP) ; Save word count Tst Q$WCnt(R4) ; Handler to user buffer? Bpl 10$ ; Branch if yes Cmp (R5)+,(R5)+ ; Don't write 2-word header .If EQ MMG$T Cmp (R2)+,(R2)+ ; Skip over 2-word header .IfF ;EQ MMG$T Add #4,Q$Buff(R4) ; Skip over 2-word header .ENDC ;EQ MMG$T Sub #2,R1 ; Subtract 2 from word count 10$: Call COPYTO ; Do the copy CopRet: Mov (SP)+,R1 ; Restore word count Return .Dsabl LSB .Enable LSB Cont: Mov LdCQE,R4 ; point to current queue element CK.R4=Q$BlkN ;***************************************; next instruction put over NOP by DBGQue: BPT ;3 SET LD BPT=1 .=:DBGQue;******************************;3 NOP ;3 ;**************************************** Mov #Handlr,R5 ;2 point to handlr table $Rel .-2 Handlr LD ;2 CK.R5=Handlr CK.R4 Q$BlkN MovB Q$Unit(R4),R2 ; Extract bits <2:0> of Bic #^cLOmask,R2 ; unit number from QEL. CK.R2=CkUnit CK.R2 CkUnit .IF NE LD$N64 ; ; Next ins. overlays 1st word of MovB ;***************************************; If Init detects not 64-unit monitor, ....P3: Br ..NoE1 ;6 no extra unit # bits to fool with .=:....P3;******************************;6 ;6 The QEL contains bits ;6 <5:3> of the unit number in ;6 bits <6:4> of Q$FUNC. MOVB Q$FUNC(R4),R1 ;6 Get Function specifier byte. BPL 10$ ; (If bit 7 is set, then it is a COMB R1 ; SPFUN, and bits <6:4> are actually ; the 1's complement of their ; real value. 10$: ; Extract bit <6:4> BIC #^cHImask,R1 ; of Q$FUNC. ASR R1 ; Align field to <5:3> BISB R1,R2 ; Insert to make it the high ; 3 bits of the unit number. ..NoE1: .ENDC ;NE LD$N64 Cmp R2,#.-. ; Is unit out of I/O range? .LdCIU=:.-2 Bhis LdEr1 ; Branch if so Asl R2 ; Convert unit number to word index CK.R2=CkUnit*2 CK.R4 Q$BlkN MovB Q$Func(R4),R1 ; get possible .SpFun code Bpl RelCk ; not a .SpFun ; Specified function is a SPFUN: .IF NE LD$N64 ; ; Next ins. overlays 1st word of Bic ;***************************************; If Init detects not 64-unit monitor, ....P4: Br ..NoE2 ;6 no extra unit # bits to fool with .=:....P4;******************************;6 ;6 The QEL contains bits ;6 <5:3> of the unit number in ;6 bits <6:4> of Q$FUNC. Bic #^c17,R1 ;6 Extract bits <3:0> of specifed Add #SpfBas,R1 ; function and convert it to ; the "real" SPFUN code. ..NoE2: .ENDC ;NE LD$N64 CmpB #Upd$Fn,R1 ; is it the LD update function? Bne 50$ ; no CK.R5A=CK.R5 Cmp -(R5),-(R5) ; also pass ^rLD and unit count CK.R5A BufLow,-2-2 CK.R4 Q$BlkN Mov Q$Buff(R4),R2 ; point to user's buffer CK.R2A=CkUBuf CK.R4 Q$BlkN Mov Q$WCnt(R4),R1 ; handler to buffer? .Assume H2B GT 0 Bpl 20$ ; Branch if yes Neg R1 ; ABS(Word_count) 20$: Cmp R1,#1 ; Is it the special case? Bhi 30$ ; Branch if not Mov #8.+2,R1 ; First table + 2-word header Call Copy2 ; Copy it Tst -(R1) ; Change the 10. in R1 to a 8. Add #Offset-,R5 ; Copy 8 words from/to the Call CopyTo ; "offset" table. Add #Size-,R5 ; Copy 8 words from/to the Call CopyTo ; "size" table. Asl R1 ; Change the 8. in R1 Asl R1 ; to 8*4 Add #Name-,R5 ; Copy 8*4 words from/to the Call CopyTo ; "name" table. Br LdDon1 ; finished .............. 30$: Cmp R1,#H2B ; Use MIN(specified size, Blos 40$ ; Handler_table_size) Mov #H2B,R1 ; as the xfer word count. 40$: Call COPY2 Br LdDon1 ; finished .............. 50$: CmpB #Siz$Fn,R1 ; Is it the Size function? Bne LdDon1 ; no, "ignore" it ; ; then must be Size request .Assume Ld.Act EQ 100000 CK.R2 CkUnit*2 Tst Handlr(R2) ;2 active? $Rel .-2 Handlr LD ;2 CK.R4A=CK.R4 Bpl LdEr1 ; error, not active .If EQ Mmg$t CK.R2 CkUnit*2 CK.R4 Q$BlkN Mov Size(R2),@Q$Buff(R4) ;2 Return device size $Rel .-4 Size LD ;2 .IfF ;EQ Mmg$t CK.R2 CkUnit*2 CK.SP=CkSP Mov Size(R2),-(SP) ;2 Return device size $Rel .-2 Size LD ;2 CK.SP ,-2 Call @$PtWrd ; Store size in buffer CK.SP ,+2 CK.SP CkSP .EndC ;EQ Mmg$t LdDon1: ; make previous BRs reach Jmp LdDone ; done with size operation .............. .SbTtl Check the .Release/$UNLOAD bit .Enable LSB RelCk: Bit #LDRel$,@#ConFg2 ;3 test for a .Release or $UNLOAD $Rel .-2 ConFg2 RMON ;3 .CnFg2=:.-2 ;3 Boff 20$ ; no, tables are ok Bic #LDRel$,@.CnFg2 ; reset flag Mov .LdCIU,R1 ; check all I/O units for validity Add R1,R5 ; point to end of table Add R1,R5 ; (words so add twice) 10$: Bis #Ld.Unx,-(R5) ; indicate index unknown ; (and reset R5 at end) Sob R1,10$ ; do all units .Br 20$ .SbTtl Check for valid info about LDn: unit n 20$: CK.R2 CkUnit*2 CK.R5 Handlr Add R2,R5 ; point to entry of interest CK.R5=CkCurr CK.R5 CkCurr Tst @R5 ; is this an active unit? .Assume Ld.Act EQ 100000 CK.R4B=CK.R4 CK.R5 CkCurr BMI 30$ LdEr1: ; make previous branches reach JMP LDerr 30$: BitB #Ld.UNx!Ld.UOf,@R5 ; are the index and offset up to date? Boff LimCk ; yes .Assume Ld.UNx NE 200 .Assume Ld.UOf EQ 200 CK.R4C=CK.R4 Bmi LdEr1 ; no, offset wrong, give up Mov R2,R1 ; copy unit offset value CK.R1=CK.R2 Asl R1 ; make into 4 word index CK.R1=CK.R1*2 Asl R1 ; ... (was a 1 word index) CK.R1=CK.R1*2 CK.R1 CkUnit*8. CK.SP=CkSP Mov R2,-(SP) ; save work register CK.SP ,-2,CkR2 CkSP1=CK.R2 CK.R1 CkUnit*8. Mov Name(R1),-(SP) ;2 copy name $Rel .-2 Name LD ;2 CK.SP ,-2,S.Name Beq 60$ ; if blank, then an error Mov RM.PNm,R2 ; Assume device name in LD table is 2-char Bitb #Msk345,1(R5) ; Is the unit # in the entry 0..7? Beq 40$ ; Branch if yes Mov RM.PN2,R2 ; No, device name in LD table is 1-char 40$: Clr R1 50$: CK.SP S.Name Cmp @SP,(R2)+ ; look for handler Beq 70$ ; found it; C=0 if branch taken Tst (R1)+ ; bump $PNAME index Cmp R1,$LOT.2 ; out of possible names? Bne 50$ ; no, keep looking CK.R4D=CK.R4 60$: Sec ; Not found ($REMOVEd?) 70$: Bit (SP)+,R2 ;*C* dump name from stack CK.SP ,+2 Mov (SP)+,R2 ;*C* restore registers CK.SP CkR2,+2 CK.SP CkSP CK.R2=CkSP1 CK.R4E=CK.R4 Bcs LdNoDv ; no device error CK.R5 CkCurr MovB R1,@R5 ; save index .Assume <&Ld.UNx> EQ 0 ; this clears Ld.UNx .Br LimCk .SbTtl Validate request (R/O) and block limits ok .Enable LSB LimCk: CK.R4 Q$BlkN Mov Q$WCnt(R4),R1 ; get count Bpl ReadCk ; Read (or Seek) ; ; else is a Write CK.R5 CkCurr Bit #Ld.RdO,@R5 ; is writing allowed? CK.R4F=CK.R4 Bon LdErr ; no, then issue error Neg R1 ; make word count + ReadCk: ; Read (or Seek, which passes thru) CK.R4 Q$BlkN CK.R2 CkUnit*2 Cmp @R4,Size(R2) ;2 inside logical disk? $Rel .-2 Size LD ;2 CK.R4G=CK.R4 Bhis LdErr ; no, error Add #WdsBlk-1,R1 ; round partial blocks up ClrB R1 ; clear any junk .Assume WdsBlk EQ 400 SwaB R1 ; divide by 256. CK.R4 Q$BlkN Add @R4,R1 ; add beginning block Bcs 10$ ; truncate and error CK.R2 CkUnit*2 Cmp R1,Size(R2) ;2 all inside logical disk? $Rel .-2 Size LD ;2 Blos FixOft ; yes, fix offset 10$: CK.R4 Q$BlkN Bis #HdErr$,@Q$CSW(R4) ; Set I/O error in CSW CK.R2 CkUnit*2 Mov Size(R2),R1 ;2 get size $Rel .-2 Size LD ;2 CK.R4 Q$BlkN Sub @R4,R1 ; less first block of transfer SwaB R1 ; convert difference to words CK.R4 Q$BlkN Tst Q$WCnt(R4) ; Is request a read? Bpl 20$ ; Branch if yes Neg R1 ; Negative word count means a write 20$: Mov R1,Q$WCnt(R4) ; then substitute new transfer count .Br FixOft FixOft: CK.R2 CkUnit*2 CK.R4 Q$BlkN Add Offset(R2),@R4 ;2 add offset to block number $Rel .-2 Offset LD ;2 CK.R2 CkUnit*2 MovB Handlr+1(R2),R1 ;2 get unit number $Rel .-2 Handlr+1 LD ;2 CK.R1=CkNUnit Bic #^cUntMsk,R1 ; Clear all but new unit number Mov R1,-(SP) ; Save a copy of new unit number. BicB #LOmask,Q$unit(R4) ; Insert bits <2:0> BicB #^cLOmask,R1 ; of new unit number BisB R1,Q$unit(R4) ; in QEL unit number. BicB #HImask,Q$func(R4) ; MovB @R5,R5 ; Get device index value ; ; Next ins. overlays 1st word of CMP ;***************************************; If Init detects not 64-unit monitor, ....P1: Br ..No64 ;6 no check for 64-unit handler .=:....P1;******************************;6 Cmp $PName(R5),.-.(R5) ;6 Is it a 64-unit handler? $Rel .-4 $PName RMON ;6 RM.PNm=:.-4 ;6 RM.PN2=:.-2 ;6 Beq ..No64 ; Branch if not Mov @SP,R1 ; Restore new unit number. Asl R1 ; Insert bits <5:3> BicB #^cHImask,R1 ; of new unit# into BisB R1,Q$func(R4) ; bits <6:4> of "Q$FUNC". ..No64: Mov (SP)+,R1 ; Restore unit number .If EQ LD$Own .Br ReQue .IfF ; EQ LD$Own .Br OwnCk .SbTtl Process ownership validation .Enable LSB OwnCk: CK.R1 CkNUnit Asr R1 ; Unit/2 CK.R1=CkNUnit/2 ; ; next instruction overlays Asl ;***************************************; if Init detects no $OWNER table ..NoOw: Br ..NoCk ;3 no check to do .=:..NoOw;******************************;3 Asl R5 ;3 Conv. $PNAME index to $OWNER index Add #.-.,R5 ;2 point to ownership double-word RM.Own=:.-2 ;2 ; ; next instruction overlays Cmp ;***************************************; if Init detects non-64-unit monitor ....P2: Br ..NoEU ;3 don't check handler for 64-unit .=:....P2;******************************;3 Cmp #2,@R5 ;3 If the first word of the $OWNER Bne ..NoEU ; table contains a 2, then the second ; word contains the ptr to the actual ; $OWNER table entry. Mov 2(R5),R5 ; Get ptr to "real" owner table entry. Beq LdNoDv ; Handler isn't there! ..NoEU: Add R1,R5 ; Compute offset of byte containing ; the nibble and MovB @R5,R5 ; fetch it. CK.R5=CkJunk CK.R2 CkUnit*2 Bit #Odd,Handlr(R2) ;2 Odd unit? $Rel .-2 Handlr LD ;2 Boff 10$ ; no .Rept 4 ; move a nybble Asr R5 ; test high nybble .EndR 10$: Bic #^cOwnMsk,R5 ; clear junk bits Boff ReQue ; public Dec R5 ; dump "guard" bit CK.R4 Q$BlkN MovB Q$JNum(R4),R1 ; get queue element job number Asr R1 ; align Asr R1 ; ... Asr R1 ; ... Bic #^cJobMsk*2,R1 ; clear junk bits Cmp R1,R5 ; is this the same job? CK.R4H=CK.R4 Bne LdErr ; no, then can not do I/O .Br ReQue ..NoCk: ; place to skip to if SJ .EndC ;EQ LD$Own .SbTtl Requeuing process ReQue: CK.R2 CkUnit*2 MovB Handlr(R2),R2 ;2 point to index $Rel .-2 Handlr LD ;2 Mov .-.(R2),R2 ;2 point to handler RM.Ent=:.-2 ;2 CK.R4H=CK.R4 Beq LdNoDv ; after all this, the handler is gone Clr LdCQE ; no current element Clr LdLQE ; empty queue Add #2,@SP ; return to requeue Return ;2 also ABORT entry LDInt:: ;2 must FOLLOW a RETURN instruction ...... LdNoDv: LdErr: .IRpC x, CK.R4'x Q$BlkN .EndR Bis #HdErr$,@-(R4) ; assume R4 pointing to queue element LdDone: .DrFin LD .......... .DrEnd LD .SbTtl Load/fetch and unload/release one-time code .PSect SETOVR .Enable LSB SetOvr: .IF NE LD$N64 .SBTTL UNI$FX - make appropriate 64-unit adjustments (64 UNITS ONLY!!!) ;+ ; UNI$FX - fix pointers in $OWNER table so as to support up to 64 units. ;- UNI$FX: MOV R0,-(SP) MOV R1,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) MOV @#JRmon,R0 ;does the running monitor support BIT #CF3.64,CNFG3(R0) ;extended unit handlers? BEQ 10$ ;If not, branch and get out BIT #CF3.OW,CNFG3(R0) ;Does $OWNER table exist? BEQ 10$ ;If not, branch and get out ; ; Set up $SLOT*5 for later reference ; MOV R2,R3 ;R3 := $SLOT*2 ASL R3 ASL R3 ;R3 := R3*4 ADD R2,R3 ;R3 = $SLOT*5 CALL FIXOWN ;put address of extended ownership table ;into $OWNER+2, and put the address ;$OWNER+2 in R1 10$: CLC MOV (SP)+,R5 MOV (SP)+,R4 ;restore registers MOV (SP)+,R3 MOV (SP)+,R1 MOV (SP)+,R0 RETURN .SBTTL UNL$64 - unload code for 64 unit handler (64 units only!!) ;+ ; UNL$64 - additional unload code for 64 unit handler ; ; For a 64 unit handler, the second word of the $OWNER table needs to ; to be zeroed at unload time UNL$64: MOV @#JRmon,R0 ;R0 -> base of RMON BIT #CF3.64,CNFG3(R0) ;64-unit support in running monitor BEQ 20$ ;branch if not extended unit support BIT #CF3.OW,CNFG3(R0) ;Does $OWNER table exist? BEQ 20$ ;Branch if not ; ; Obtain $SLOT*5 ; MOV R2,R3 ;R3 := $SLOT ASL R3 ASL R3 ADD R2,R3 ;R3 = $SLOT*5 CALL FIXOWN ;R1 -> $OWNER+2 CLR @R1 20$: RETURN .SBTTL FIXOWN - insert pointer to extended ownership table into $OWNER ;+ ; FIXOWN - insert pointer to extended ownership table into second word ; of $OWNER table (64 UNITS ONLY!!!) ; ; INPUT ; R2 = $SLOT*2 ; R3 = $SLOT*5 ; R5 -> $ENTRY entry for this handler ; LD$X64: extended ownership table ; ; OUTPUT ; $OWNER+2 points to extended ownership table ; R1 points to $OWNER+2 ;- FIXOWN: MOV @#JRMON,R1 ;R1 -> JRmon MOV $PNPTR(R1),-(SP) ADD R1,@SP ;@SP -> beginning of $PNAME ADD R2,@SP ;@SP -> beginning of $ENTRY MOV R5,R1 ;R1 -> $ENTRY entry for this handler SUB (SP)+,R1 ;R1 = byte offset into $ENTRY ADD R5,R1 ;R1 = $ENTRY + double-word index SUB R3,R1 ;R1 -> $OWNER of this handler + 8. CMP -(R1),-(R1) ;R1 -> $OWNER of this handler + 4 MOV @R5,-(R1) ;move addr of LDLQE into $OWNER+2 ADD #LD$X64-LDLQE,@R1 ;make $OWNER (pic) to point to ;extended ownership table RETURN .ENDC ;NE LD$N64 .Enable LSB Init:: Nop ; patch to BPT for debugging .IF NE LD$N64 CALL UNI$FX ; make appropiate 64-units adjustments .ENDC ;NE LD$N64 Mov @#JRMon,R4 ; point to RMON CK.R4=JRmon Mov @R5,R1 ; point to handler ; REM: R2 still contains $SLOT*2 MOV R2,$LOT.2-LDBASE(R1) ; Save this very valuable piece of ; information. CK.R1=LdBase RM.Did = 1 .Rept RM.Cnt .Irp x,<\RM.Did> CK.R4 JRmon CK.R1 LdBase Add R4,RM.'x-LdBase(R1) ; relocate using JRMon as base .EndR RM.Did = RM.Did+1 .EndR .Addr #LD.Lst,R0 ; point to LD relocation list 10$: Mov (R0)+,R5 ; get next reloc list entry Bmi 20$ ; done this list CK.R1 LdBase Add R1,R5 ; real address to locate CK.R1 LdBase Add R1,@R5 ; relocate value in address Br 10$ ; and do next .......... 20$: CK.R1 LdBase Mov @RM.PNm-LdBase(R1),R5 ; get offset to $PName table CK.R4 JRmon Add R4,R5 ; make it into an addr CK.R1 LdBase Mov R5,RM.PNm-LdBase(R1) ; and put it in the handler Mov R5,R3 ; R3 -> $PName table Add R2,R3 ; R3 -> $Entry table CK.R1 LdBase Mov R3,RM.Ent-LdBase(R1) ; save address of $Entry table Add R2,R3 Tst (R3)+ ; R3 -> $Stat table Mov R2,R0 ; R0 = $Slot*2 ASL R0 ; R0 = <$Slot*2>*2 ASL R0 ; R0 = <$Slot*2>*4 Add R0,R3 ; R3 -> $PNam2 table CK.R1 LdBase Mov R3,RM.PN2-LdBase(R1) ; save address of $PNam2 table .If NE LD$Own ;>>> SB/XB implications? Sub R0,R5 Sub #8.,R5 ;R5 -> $Owner table CK.R1 LdBase MOV R5,RM.Own-LdBase(R1) ; save address of $Owner table CK.R4 JRmon Bit #CF3.Ow,CNFG3(R4) ; Ownership support in monitor? Bon 30$ ; yes CK.R1 LdBase Mov #.-.,..NoOw-LdBase(R1) ;2 no, patch out $OWNER testing .....1=. .=.-4 Br ..NoCk-..NoOw+. ;2 a "BR ..NoCk" at ..NoOw (DATA) . =.....1 30$: .EndC ;NE LD$Own MOV #64.,R0 ; Assume monitor supports 64-unit Bit #CF3.64,CNFG3(R4) ; 64-unit support in monitor? Bon 40$ ; Branch if yes MOV #8.,R0 ; Monitor does not support 64-unit CK.R1 LdBase Mov #.-.,....P1-LdBase(R1) ;2 Patch out 64-unit handler test .....2=. .=.-4 Br ..No64-....P1+. ;2 a "BR ..No64" at ....P1 (DATA) . =.....2 .If NE LD$N64 CK.R1 LdBase Mov #.-.,....P3-LdBase(R1) ;2 Patch out 64-unit handler test .....4=. .=.-4 Br ..NoE1-....P3+. ;2 a "BR ..NoE1" at ....P3 (DATA) . =.....4 CK.R1 LdBase Mov #.-.,....P4-LdBase(R1) ;2 Patch out 64-unit handler test .....5=. .=.-4 Br ..NoE2-....P4+. ;2 a "BR ..NoE2" at ....P4 (DATA) . =.....5 .Endc ;NE LD$N64 .If NE LD$Own CK.R1 LdBase Mov #.-.,....P2-LdBase(R1) ;2 Patch out 64-unit handler test .....3=. .=.-4 Br ..NoEU-....P2+. ;2 a "BR ..NoEU" at ....P2 (DATA) . =.....3 .EndC ;NE LD$Own 40$: Mov #LD$UNI,R3 ; .LdCIU is the number of currently Cmp R0,R3 ; usable units for I/O and .SpFuns Bhis 50$ Mov R0,R3 50$: Mov R3,.LdCIU-LdBase(R1) Clc ; indicate no error Return ...... LD.Did = 1 LD.Lst: .Rept LD.Cnt .Irp x,<\LD.Did> .Word LD.'x-LdBase .EndR LD.Did = LD.Did+1 .EndR .Word -1 ; end of list .=. .Assume . LE SetOvr+<2*1000>,MESSAGE=<;Init code overflow> .Assume LD.Cnt EQ LD.Did-1 .Assume RM.Cnt EQ RM.Did-1 .SbTtl LDRun - control LD handler .PSect LDRUN .Enable LSB LDRun:: ; entry point Nop ; possible BPT (patch for debug) ...CmZ Fudge=.LD ; .SErr ; get errors, don't die Mov #ClrLow,R0 ; clear impure area Mov #ClrHi-ClrLow/2,R1 ; size to clear in words 10$: Clr (R0)+ ; clear a word Sob R1,10$ ; do all of them ; assume normal entry (prev clears R1) Mov #Unit64,R3 ; Assume 64-unit Mov @#JRMon,R0 ; Point to beginning of fixed offsets Bit #Cf3.64,Cnfg3(R0) ; Does monitor support 64-units? Bon 20$ ; Branch if yes Mov #Unit8,R3 ; We have an 8-unit monitor 20$: Mov R3,R0 ; Assume I/O units are what monitor ; can support Cmp R0,#LD$UNI ; Is that more than LD was genned for? Blos 30$ ; If not, then use monitor's count Mov #LD$UNI,R0 ; else, use genned count 30$: Mov R0,LdCIU ; Current # of LD units capable of I/O Mov R3,R0 ; Assume mountable units are what ; monitor supports Cmp R0,#LD$PMU ; Is it more than mountable units Blos 40$ ; genned for? Branch if not Mov #LD$PMU,R0 ; Use # of mountable units genned for 40$: Mov R0,LdCMU ; Current # of mountable LD units Dec R0 ; R0 = highest mountable unit Mov R0,R3 ; Isolate last Bic #^cOctMsk,R3 ; octal digit of unit number Add #Bin2As,R3 ; Convert it to ASCII Asr R0 ; Isolate Asr R0 ; first Asr R0 ; octal digit Bic #^cOctMsk,R0 ; of unit # Bne 50$ ; Branch if unit # > 7 Mov #Space-Bin2As,R0 ; Convert leading 0 to space 50$: Add #Bin2As,R0 ; Convert first digit to ASCII MovB R0,SwtRng ; Store 1st digit of unit (or space) MovB R3,SwtRng+1 ; Store 2nd digit of unit # ; in range message Bit #Chain$,@#JSW ; chained to? Boff 60$ ; no Mov #ChnArg,R1 ; assume command string CmpB #ChnNon,@R1 ; none? Bne 60$ ; there is a command Clr R1 ; no command, chained to w/o arg 60$: Mov #CmdBuf,R3 ; point to command buffer CK.R3=CmdBuf CK.R3 CmdBuf Mov R3,CmdPtr ; set output pointer Clr CmdCnt ; clear length CK.SP=CkSP CK.R3 CmdBuf .CSISpc #Out1,#DefExt,R1,R3 ; get command line parsed CK.SP ,-2,CkSNum Bcc 70$ ; no command line error Jsr R0,ErrMsg .Word MsgCsi ; CSI error Br Done2 ; done ........... 70$: CK.R3 CmdBuf TstB @R3 ; empty command line? Bne 80$ ; no, process it .Print #MsgId ; tell who we are & our version info Br Done2 ; and finished ............ 80$: ; make output file entries looks like ; input file entries by moving them up Mov #In1,R0 ; point to place for it +2 Mov R0,R1 .Rept 3 Tst -(R0) ; skip size .Rept 4 Mov -(R0),-(R1) ; move dblk .EndR .EndR .Br CkSys .SbTtl Insure that system channel open on LD handler on SY: .Enable LSB CkSys: Mov @#JRmon,R5 ; point to RMON CK.R5=JRmon Mov #LD$Nam,R2 ; get our name CK.R5 JRmon Add Suffix(R5),R2 ; add in any suffix letter (GVAL) Mov R2,DBlock+O.Name ; and put in dblock .CStat #CStatS,Code=NoSet ; are we running from SY:? Bic #^cLd$Ndx,CStat ; save only device index CK.R5 JRmon Cmp SyIndx(R5),CStat ; is it the system device? (GVAL) Bne 10$ ; no CK.R5 JRmon CmpB SyUnit(R5),CStat+C.Unit ; is it the right unit? (GVAL) Beq DoSwt ; yes, all is well 10$: .Purge #SysChn ; close the system channel Mov #<^rSY >,DBlock+O.Dev ; refer to SY device Clr DBlock+O.Name+2 ; and clear second part of name Mov #<^rSYS>,DBlock+O.Type ; and type .LookUp #LukUpS,Code=NoSet ; find ourselves Bcc 20$ ; found LD.SYS Jmp NoLErr ; else error .............. 20$: Bit #Chain$,@#JSW ; chained to? Bon 40$ ; yes, then chain to proper LDx.SYS Clr @#ChnFrm ; else indicate EXIT / not chain back Mov #CmdBuf,R0 ; point to command line Mov #ChnArg,R1 ; point to argument area 30$: MovB (R0)+,(R1)+ ; copy string Bne 30$ ; up to and including 40$: .Chain ; and away ...... ErrUkS: Jsr R0,ErrMsg .Word MsgUkS ; Unknown option letter Br Done2 ; done ............ ErrNoV: Jsr R0,ErrMsg ; required value missing .Word MsgNoV ; no value Br Done2 ............ Vl2Mny: Jsr R0,ErrMsg ; required value missing .Word MsgV2M ; too many /R and /W options Br Done2 ............ .SbTtl Process Options .Enable LSB DoSwt: Mov #RVals,RValsP ; init pointer to space for /R values Mov #WVals,WValsP ; init pointer to space for /W values Mov #H2B,R5 ; handler to buffer Call SpFun ; get from handler Mov #CheckV,R5 ; point to commonly used subr CK.R5=CheckV CK.SP CkSNum,+2 Mov (SP)+,R1 ; get option count Bne NxtSwt ; anything to do? Done2: Jmp Done ; no ............ NxtSwt: Mov #SwList-2,R2 ; point to option table ; offset for first (R2)+ CK.R2=SwSubr Mov (SP)+,R0 ; get option letter and file number CmpB R0,#LC.a ; is it lowercase? Blo 10$ ; no CmpB R0,#LC.z ; is it really? Bhi 10$ ; no Bic #LC2UC,R0 ; force uppercase 10$: 20$: CK.R2 SwSubr,+2 Tst (R2)+ ; skip address entry CK.R2 SwLeng .Assume SwEOL EQ 0 CK.R2=SwEOL CK.R2 SwEOL,+1 TstB (R2)+ ; end of list? .Assume SwLEnd LT 0 Bmi ErrUkS ; yes, illegal option letter CK.R2 SwLtr,+1 CmpB (R2)+,R0 ; match? CK.R2 SwSubr Bne 20$ ; no CK.R2 SwSubr Jmp @(R2)+ ; go to option action routine ............ Swt$: Mov R0,Flag$ ; indicate /$ found Bpl SwtXit ; no value associated Tst (SP)+ ; dump value Br SwtXit ; done ............. SwtA: Tst R0 ; any value specified? Bpl ErrNoV ; no, then an error Mov (SP)+,ValueA ; save for later Br SwtNoC ; continue processing ............. SwtC: Mov R0,FlagC ; indicate /C given, pop letter ; from stack Bpl SwtXit ; no value Mov (SP)+,ValueC ; save value Br SwtXit ; continue processing ............. SwtE: Mov R0,FlagE ; indicate /E given, pop letter ; from stack Bpl 30$ ; no value Tst (SP)+ ; ignore value 30$: Inc FlgNoC ; indicate non-/C found Br SwtXit ; continue processing ............. SwtL: ; /L Sec ; indicate that option value required CK.R5 CheckV Call @R5 ; validate option value CK.R3=CkUnit*2 ;from CheckV CK.R3 CkUnit*2 Bis #Sw.L,Table(R3) ; indicate /L for this file SwaB R0 ; get file number in low byte Bic #^cFilNum,R0 ; clear junk CK.R3 CkUnit*2 MovB R0,Table(R3) ; save unit for this file CK.R3 CkUnit*2 AsrB R3 ; /2 (was word index) CK.R3=CK.R3/2 CK.R3 CkUnit MovB R3,UnitA ; save unit number for assign Inc CountL ; count number of /L options Br SwtNoC ; done ............. SwtR: ; /R Clc ; indicate that value not required CK.R5 CheckV Call @R5 ; validate option value CK.R3=CkUnit*2 ;from CheckV CK.R3 CkUnit*2 Cmp RValsP,WValsP ; too many /R and /W values to save? Bhis Vl2Mny ; branch if yes Mov R3,@RValsP ; save /R unit index Add #2,RValsP ; bump pointer Br SwtNoC ; done ............. SwtW: ; /W Clc ; indicate that value not required CK.R5 CheckV Call @R5 ; validate option value CK.R3=CkUnit*2 ;from CheckV CK.R3 CkUnit*2 Cmp RValsP,WValsP ; too many /R and /W values to save? Bhis Vl2Mny ; branch if yes Sub #2,WValsP ; decrement pointer Mov R3,@WValsP ; save /W unit index .Br SwtNoC ; done SwtNoC: Inc FlgNoC ; indicate non-/C found SwtNoE: Inc FlgNoE ; indicate non-/E found SwtXit: DEC R1 BNE NXTSWT .Br CkSwt ; check the options .SbTtl CkSwt - verify correct option selections ;+ ; The following are the correct option combinations: ; ; /C[:-1] do a clean operation ; -1 implies no fatal errors allowed ; /C must be only option specified ; /$ will be allowed, and ignored ; ; [FilSpc]/L:n[/R:n!/W:n][/$][/A:rrr] do a mount/dismount ; FilSpc present means mount ; FilSpc absence means dismount ; /R means read-only ; /W means read-write ; only /W or /R, not both ; /$ means LOAD for a mount (DCL) ; /A means Assign LDn rrr ; if /A then only 1 /L allowed ; ; /R:n make LDn read-only ; ; /W:n make LDn read-write ;- .Enable LSB CkSwt: Mov #RVals,R0 ; point to top of /R values Mov RValsP,R1 ; point past /R values Mov #Sw.R,R2 ; /R attribute bit in Table Call SetAtt ; set /R attribute bit for files Mov WValsP,R0 ; point to top of /W values Mov #WVals,R1 ; point past /W values Mov #Sw.W,R2 ; /W attribute bit in Table Call SetAtt ; set /W attribute bit for files Tst FlagC ; was /C specified? Boff 10$ ; no Tst FlgNoC ; was another option specified? Boff 50$ ; no, process /C Jsr R0,ErrMsg ; /C with other options .Word MsgSwC Br Done1 ............. 10$: Tst FlagE ; was /E specified? Boff 20$ ; no Tst FlgNoE ; was another option specified? Boff 30$ ; no, process /E Jsr R0,ErrMsg ; /E with other options .Word MsgSwE Br Done1 ............. 20$: Tst ValueA ; was /A specified? Boff DoFile ; no Dec CountL ; should be exactly 1 /L Beq DoFile ; process request Jsr R0,ErrMsg ; /A but not exactly 1 /L .Word MsgALS Done1: Jmp Done ............ 30$: Mov #LD$PMU,R2 ; clear all possibly mountable units Mov #Table,R5 ; point to intermediate info tables 40$: Bis #Sw.L,(R5)+ ; Masquerade as a dismount for Sob R2,40$ ; each unit Br DoFile ; Process dismounts (SET LD EMPTY) .............. 50$: Mov #Handlr,R5 ; point to "Handlr" which is "Table" CK.R5=Handlr Mov #Name,R4 ; point to "Name" which is "CsiSpc" CK.R4=O.Dev Mov #In1-<3*>,R3 ; and to "real" "CsiSpc" CK.R3=O.Dev Clr R1 ; start units at 0 Mov #.-.,R2 ; do all I/O unit entries LdCIU=:.-2 .Br 60$ 60$: CK.R5 Handlr,+1 MovB R1,(R5)+ ; supply file number Inc R1 ; calc next file number CK.R5 Handlr+1,+1 MovB (R5)+,R0 ; get unit # Bic #^cUntMsk,R0 ; isolate just unit bits Mov R0,-(SP) Bic #7,R0 Beq 70$ Asl R0 Asl R0 Add #Bn2Rd2,R0 70$: Add (SP)+,R0 Add #Bn2Rd1,R0 ; convert to number in RAD50 CK.R4 O.Dev,+2 CK.R3 O.Dev,+2 Mov (R4)+,(R3)+ ; add in device name Beq 80$ ; branch if no device Add R0,-2(R3) ; and add in RAD50 unit number 80$: CK.R4 O.Name,+2 CK.R3 O.Name,+2 Mov (R4)+,(R3)+ ; move name and type CK.R4 O.Name+2,+2 CK.R3 O.Name+2,+2 Mov (R4)+,(R3)+ ; ... CK.R4 O.Type,+2 CK.R3 O.Type,+2 Mov (R4)+,(R3)+ ; ... CK.R4 O.Leng CK.R3 O.Leng Sob R2,60$ ; move all entries Mov #Handlr,R2 ; point to "table" for common code CK.R2A=Handlr Br DoSwtC ; join common code .............. ErrNoF: Jsr R0,ErrMsg .Word MsgNoF ; no file specified Br FilXi1 ; skip to next entry .............. ErrDev: Jsr R0,ErrMsg .Word MsgDev ; no device handler exists Br FilXi1 ; skip to next entry .............. ErrRan: Jsr R0,ErrMsg .Word MsgRan ; not random access FilXi1: Bic #Ld.Act,@R4 ; dismount current LD unit Jmp FilXit ; skip to next entry .............. ErrHTB: Jsr R0,ErrMsg .Word MsgHTB ; settop failed Br SetTo1 ; reset SetTop, skip to next entry .............. ErrFet: Jsr R0,ErrMsg .Word MsgFet ; fetch failed Mov Sp,Feterr ; indicate that a .FETCH error occurred Tst FlagC ; doing /C? Boff Done1 ; branch if not SetTo1: Jmp SetTop ; reset SetTop, skip to next entry .............. ErrFNF: CK.SP=CkFlag Jsr R0,ErrMsg .Word MsgFNF ; LookUp error CK.SP ,+2 Tst (SP)+ ; align stack CK.SP CkSP Br Done1 ............. .SbTtl Process input and update handler tables .Enable LSB DoFile: Mov #Table,R2 ; point to intermediate info tables CK.R2=Table DoSwtC: CK.R2A Handlr Mov #In1-<3*>,R1 ; point to input file specifications ; biased since In1 is file 3 CK.R1=O.Dev Mov #Handlr,R4 ; point to handler flags table CK.R4=Handlr Clr R5 ; current LD unit number NxtFil: ; file spec processing loop CK.R2 Table Tst @R2 ; File operation option? .Assume 100000 EQ Sw.L Bpl 10$ ; no, skip it CK.R4 Handlr Bic #Ld.Act!Ld.UOf,@R4 ; assume no file spec, but good offset CK.R2 Table MovB @R2,R3 ; get file number (or unit number ; used like a file number (0-77)) CK.R3=CkFile Bic #^cUntMsk,R3 ; clear junk bits CK.R3 CkFile Asl R3 ; make into 4 word index CK.R3=CK.R3*2 Asl R3 ; ... CK.R3=CK.R3*2 Asl R3 ; ... CK.R3=CK.R3*2 CK.R3 CkFile*8. Add R1,R3 ; point to Dblock entry CK.R3=O.Dev Tst @R3 ; any file specification? Bon 20$ ; yes 10$: Jmp 140$ ; no, try other options .......... 20$: CK.R3 O.Dev Tst O.Name(R3) ; is it a file or just a device? CK.R3W=CK.R3 Boff ErrNoF ; no file specified CK.R4 Handlr Bis #Ld.Act!Ld.UNx,@R4 ; file was specified, index need checking CK.SP=CkSP CK.SP ,-2,CkR1 Mov R1,-(SP) ; save a work register Mov #DStat,R1 ; get answer area address Tst FlagC ; doing /C operation? Boff 30$ ; no Inc R1 ; yes, do Physical DStat 30$: CK.R3 O.Dev .DStatus R1,R3 ; check out the device CK.SP CkR1,+2 Mov (SP)+,R1 ;*C* restore work register CK.SP CkSP CK.R3Z=CK.R3 Bcs ErrDev ; no handler found Tst DStat+D.Stat ; is it a "disk" (random access)? .Assume 100000 EQ FilSt$ CK.R3X=CK.R3 Bpl ErrRan ; no Tst DStat+D.EntP ; handler loaded? Bon 40$ ; yes, no need to fetch Add LimHi,DStat+D.HSiz ; calculate top of handler .SetTop DStat+D.HSiz ; ask for it Cmp R0,DStat+D.HSiz ; did we get enough space? Blo ErrHTB ; no, then we can not fetch CK.R3 O.Dev .Fetch LimHi,R3 ; fetch the handler CK.R3V=CK.R3 Bcs ErrFet ; error 40$: CK.SP=CkSP CK.SP CkFlag,-2 Clr -(SP) ; reserve flag and clear it .Assume Chan EQ 0 .Purge #0 ; purge the work channel CK.R3C=CK.R3 Call PhyLog ; set low bit in R3 if physical only CK.R3 O.Dev .LookUp #LukUpF,,R3,Code=NoSet ; look up file CK.R3 O.Dev Bic #Odd,R3 ;*C* force even Bcc 60$ ; no error .Br 50$ 50$: CK.SP CkFlag Inc @SP ; set flag non-zero if error Tst FlagC ; are we doing /C? CK.SP CkFlag CK.R3N=CK.R3 Boff ErrFNF ; no, then do error CK.R4 Handlr Bis #Ld.UOf,@R4 ; indicate offset wrong CK.SP CkFlag CK.R3 O.Dev Mov O.Name(R3),@SP ; save first part of name CK.R3 O.Dev Clr O.Name(R3) ; turn into non-file structured dblk .Lookup #LukUpF,Code=NoSet ; look up DEVICE CK.SP CkFlag CK.R3 O.Dev Mov @SP,O.Name(R3) ; and restore it. ;NOTE: the above depends on O.Name(R3) being non-zero which is checked above ; errors here are "hopeless", ignore them 60$: .CStat #CStatF,Code=NoSet ; get info about file CK.R4 Handlr MovB CStat+C.Unit,R0 ; Get device unit number Bic #^cUntMsk,R0 ; Dump all but valid bits Mov CStat+C.Leng,Size-Handlr(R4) ; save size of file CK.R4 Handlr Mov CStat+C.SBlk,Offset-Handlr(R4) ; save offset of beginning of file ; Is this a nesting within LD? .IF NE LD$N64 Cmp #LD$PN2,Cstat+C.devN ; Is the device name 'L '? Beq 70$ ; If not, then .ENDC; NE LD$N64 Cmp #LD$nam,Cstat+C.devN ; Is it 'LD '? Bne 90$ ; no, then skip rest of test 70$: Mov R5,-(SP) ; copy entry offset value $1=1 .Rept 3 Asr @SP ; make into unit number $1=$1+$1 .EndR .Assume O.Size EQ $1 CmpB (SP)+,R0 ; is the nesting valid? Bgt 90$ ; yes Beq 80$ ; no, and BAD (unit numbers are equal) Mov #NsWarn,WarnNS ; no, but only a minor problem Br 90$ ; and join common code .......... 80$: Mov #NsErr,WarnNS ; a major problem 90$: CK.R4 Handlr BicB #UntMsk,1(R4) ; clear old unit number CK.R4 Handlr BisB R0,1(R4) ; save unit number of "file" .Assume Chan EQ 0 .Purge #0 ; purge the work channel CK.SP CkFlag,+2 Tst (SP)+ ; were we "recovering from FNF? Bon 120$ ; yes, skip protect and possible LOAD Tst Flag$ ; running from DCL? Boff 110$ ; no Tst DStat+D.EntP ; Was the handler loaded? Bon 110$ ; yes, no need to load it CK.SP ,-2,CkR0 Mov R0,-(SP) ; save work registers CK.SP ,-2,CkR1 Mov R1,-(SP) ; save work registers Mov CmdPtr,R1 ; point to area Mov #LCmnd,R0 ; point to prototype $LOAD ___ .Br 100$ 100$: Inc CmdCnt ; count moved chars MovB (R0)+,(R1)+ ; copy fixed part Bne 100$ ; until Null is found TstB -(R1) ; back across Null Mov CStat+C.DevN,R0 ; Rad50 of device name Call $R50Asc ; convert into ascii in low mem ClrB (R1)+ ; end in NULL Mov R1,CmdPtr ; save new pointer value Add #3,CmdCnt ; account for RAD50 converted chars CK.SP CkR1,+2 Mov (SP)+,R1 ; restore registers CK.SP CkR0,+2 Mov (SP)+,R0 ; ... CK.SP CkSP 110$: CK.R3D=CK.R3 Call PhyLog ; set low bit in R3 if physical only CK.R3 O.Dev .GFSta #GFStat,,R3,Code=NoSet ; get file status in R0 CK.R3 O.Dev Bic #Odd,R3 ;*C* force even CK.R3M=CK.R3 Bcs ErrGFS ; .GFSTa failed. Tst R0 ; is file already protected? Bmi Releas ; branch if yes ; don't try to protect again CK.R3 O.Dev Call PhyLog ; set low bit in R3 if physical only CK.R3 O.Dev .FProt #FProt,,R3,Code=NoSet ; protect the file CK.R3 O.Dev Bic #Odd,R3 ;*C* force even Bcs ErrPro ; protect failed .Br 120$ 120$: Releas: ; recovery point from ErrPro CK.R3 O.Dev .Release R3 ; release handler ; ignore any errors SetTop: .SetTop LimHi ; reset top boundary CK.R4 Handlr Bis #Ld.UNx,@R4 ; got, indicate unknown index Mov R5,R0 ; copy unit number Add #Name,R0 ; point to name entry CK.R0=O.Dev Tst FetErr ; is this a .FETCH error? Bne 130$ ; branch if so CK.R0 O.Dev,+2 Mov CStat+C.DevN,(R0)+ ; save "real" name of handler CK.R3 O.Dev,+2 Tst (R3)+ ; skip "logical" name of handler CK.R3 O.Name,+2 CK.R0 O.Name,+2 Mov (R3)+,(R0)+ ; move dblock CK.R3 O.Name+2,+2 CK.R0 O.Name+2,+2 Mov (R3)+,(R0)+ ; ... CK.R3 O.Type,+2 CK.R0 O.Type,+2 Mov (R3)+,(R0)+ ; ... 130$: Clr FetErr ; clear error flag Tst FlagC ; doing /C? Bon 140$ ; yes, leave [No]Write as is CK.R4 Handlr Bic #Ld.RdO,@R4 ; force it to allow writing 140$: ; process /W option Mov #Ld.RdO,R0 ; load Ld.RdO bit Tst FlagC ; doing /C? Bon 180$ ; if yes, /R and /W are already done Tst @R4 ; is this unit mounted? .Assume Ld.Act EQ 100000 Bmi 150$ ; branch if yes Bit #Sw.W!Sw.R,@R2 ; /R or /W specified? Beq 180$ ; branch if not Mov SP,IgnrRW ; yes, do warning Br 180$ ; nothing more to do with /R and /W ........... 150$: Bit #Sw.W,@R2 ; allow R/W Boff 170$ ; no .Assume Sw.R EQ Ld.RdO CK.R2 Table Bit R0,@R2 ; was /R also done? Boff 160$ ; no Mov SP,WarnRW ; yes, do warning 160$: CK.R4 Handlr Bic R0,@R4 ; allow read/write 170$: ; process /R option .Assume Sw.R EQ Ld.RdO CK.R2 Table Bit R0,@R2 ; make R/O? Boff 180$ ; no CK.R4 Handlr Bis R0,@R4 ; allow read only 180$: .Br FilXit FilXit: CK.R2 ,+2 CK.R4 ,+2 Cmp (R2)+,(R4)+ ; point to next table entry ; and point to next handler entry Add #O.Size,R5 ; increase unit count Cmp #LD$UNI*O.Size,R5 ; done? Beq WrapUp ; yes CK.R2 T.Leng+Table CK.R4 H.Leng+Handlr Jmp NxtFil ; no, loop again .............. ErrGFS: Jsr R0,ErrMsg ; .GFSta error .Word MsgGFS Br Releas .............. ErrPro: Jsr R0,ErrMsg .Word MsgPro ; Unable to protect file Br Releas ; release handler ... skip to next .............. .SbTtl WrapUp .Enable LSB WrapUp: Tst WarnNs ; any nesting problems? Beq 10$ ; no .Assume NsErr LT 0 Bmi ErrFNs ; yes, a bad one .Assume NsWarn GT 0 Jsr R0,ErrMsg ; yes, but a mild one .Word MsgWNs ; use warning message 10$: Clr FlagC ; no special processing for /C now .WritW #WritW,,,,,,Code=NoSet Bcc 30$ Tst LDMem ; is LD in memory? Bon 20$ ; yes, then just warn Cmp #-1,ValueC ; /C:-1? Beq 20$ ; yes, then just warn Jsr R0,ErrMsg .Word MsgWri ; WritW error (fatal level) Br Done ............ 20$: Jsr R0,ErrMsg .Word MsgWWr ; WritW error (warning level) 30$: Mov #B2H,R5 ; buffer to handler Call SpFun Done: Mov @#JSP,SP ; restore stack in case error entry Tst WarnRW ; warning message to issue? Bon 40$ ; yes Tst IgnrRW ; warning message to issue? Bon 50$ ; yes Tst HadErr ; any previous error? Bon 60$ ; yes Jsr R0,ErrMsg .Word MsgAOK ; success Br 60$ ........... 40$: Clr WarnRW ; indicate warning is done Jsr R0,ErrMsg .Word MsgWRW ; /R/W both found warning Br 60$ ........... 50$: Clr IgnrRW ; indicate warning is done Jsr R0,ErrMsg .Word MsgIRW ; /R or /W found on unmounted unit 60$: Tst CmdCnt ; any DCL command to pass Bon Kmon ; yes, return it Tst ValueA ; /A option? Bon Kmon ; yes, return it Bit #Chain$,@#JSW ; chained to? Bon 70$ ; yes .SReset ; clean up Jmp LDRun ; and get next command ............. ErrFNs: Jsr R0,ErrMsg .Word MsgFNs ; Fatal nesting problem Br 60$ ; and join common code 70$: Tst @#ChnFrm ; are we to chain back? Boff Exit ; no, done Chain: Mov #ChnTo,R2 ; point to chain to area Mov #ChnFrm,R1 ; and to program to chain to .Rept 4 Mov (R1)+,(R2)+ ; move DBLK .EndR .Assume Chan EQ 0 .Purge #0 ; close any channel in use .Chain ; and return ...... Kmon: Mov CmdPtr,R1 ; point to area Mov CmdCnt,R3 ; load counter Mov ValueA,R0 ; Rad50 of logical name Boff 100$ ; no logical name MovB #'D,UnitA-1 ; Assume $ASSIGN LDn xxx MovB UnitA,-(SP) ; Push LD unit number Bic #^cUntMsk,@SP ; Clear out junk (esp. in high byte) Cmp @SP,#7 ; Is it an extended unit? Blos 80$ ; Branch if not Asr @SP ; Isolate high octal Asr @SP ; digit in Asr @SP ; low 3 bits Add #Bin2As,@SP ; Convert high octal digit to ASCII MovB (SP)+,UnitA-1 ; Put high unit in ASSIGN string MovB UnitA,-(SP) ; Push LD unit number again BicB #^cOctMsk,@SP ; Isolate low octal digit 80$: Add #Bin2As,@SP ; Convert low octal digit to ASCII MovB (SP)+,UnitA ; Put low unit in ASSIGN string Mov #ACmnd,R2 ; point to prototype $ASSIGN LD_ ___ 90$: Inc R3 ; count moved chars MovB (R2)+,(R1)+ ; copy fixed part Bne 90$ ; until Null is found TstB -(R1) ; back across Null Call $R50Asc ; convert into ascii in low mem ClrB (R1)+ ; end in NULL Add #3,R3 ; account for RAD50 converted chars 100$: Mov #CmdBuf,R0 ; point to prototype command Mov #CmdLen,R1 ; point to command area Mov R3,(R1)+ ; put in low memory .Assume CmdLen+2 EQ CmdStr 110$: MovB (R0)+,(R1)+ ; copy command Sob R3,110$ ; all of it but logical name Bis #SpXit$!ChnIF$,@#JSW ; indicate command for Kmon Clr R0 ; hard exit ;*** NOTE: since the logical name is passed in as a option value, ; logical names beginning with numbers are illegal, because ; CSI will convert them to numeric values rather than RAD50 ones. Exit: .Exit ; and return ...... .SbTtl PHYLOG -- set low bit of R3 if /C specified .Enable LSB CK.R3C O.Dev CK.R3D O.Dev PhyLog: Tst FlagC ; doing /C? Boff 10$ ; no Inc R3 ; Use physical lookup (/C) 10$: Return .Dsabl LSB .SbTtl ErrMsg - process error messages ;+ ; ERRMSG ; ; This routine is passed the address of an error message block ; which consists of the following: ; ; .Word argument routine ; used to change args to ASCII ; [.Word argument list ; list of address(es) for routine] ; .Byte error message number ; returned on chain calls ; .Byte User Error byte value ; mask for user error byte (level) ; {.Byte 0 ; if no message} ; or ; {.Byte severity letter ; Ascii severity level letter} ; {.Asciz message ; message text} ; ; It is called by: ; ; JSR R0,ERRMSG ; .Word MSGBLK ; address of message block ;- .Enable LSB ErrMsg: CK.SP=CkSP CK.SP ,,CkR0E Mov SP,HadErr ; indicate error has happened CK.SP ,-2,CkRet Mov R0,-(SP) ; save "return" address CK.SP CkRet Add #2,@SP ; skip arg word to return address Mov @R0,R0 ; get address of error code/message CK.SPE=CK.SP-2 ;to account for call ret addr CK.R0=M.Subr CK.R0 M.Subr,+2 Call @(R0)+ ; do action routine Tst ValueC ; Was /C:-1 specified? Bge 10$ ; Branch if not CK.R0 M.Num CmpB #Warn$,M.Levl-M.Num(R0) ; Was it more severe than a warning? Bge 10$ ; Branch if not CK.R0 M.Num MovB #Warn$,M.Levl-M.Num(R0) ; Change error code to a warning CK.R0 M.Num MovB #Sev.W,M.Sev-M.Num(R0) ; Print "W-" instead of "F-" CK.SP ,-2,CkR1 10$: Mov R1,-(SP) ; save R1 Bit #Chain$,@#JSW ; were we? Boff 30$ ; no, then print message Tst @#ChnFrm ; are we to chain back? Boff 30$ ; no, then print message Mov #ChnArg,R1 ; point to return area MovB #ChnRtn,(R1)+ ; indicate return from chaining .Assume ChnErr EQ ChnArg+1 20$: MovB (R0)+,(R1)+ ; return codes and message Bne 20$ ; terminated by null Br 40$ ; and return ........... 30$: CK.R0 ,+2 Mov (R0)+,R1 ; get error code .Assume CK.R0-1 EQ M.Levl Swab R1 ; put user error part in low byte BisB R1,@#JUsErB ; set error byte CK.R0 M.Sev TstB M.Msg-M.Sev(R0) ; any message? Boff 40$ ; no CK.SP ,-2,CkR0A Mov R0,-(SP) ; save message address .Print #Prefix ; prefix message CK.SP CkR0A,+2 Mov (SP)+,R0 ; get message address .Print ; print error message 40$: CK.SP CkR1,+2 Mov (SP)+,R1 ; restore R1 CK.SP CkRet,+2 Mov (SP)+,R0 ; restore return address CK.SP CkSP Rts R0 .......... .SbTtl SpFun Subroutine .Enable LSB SpFun: .DStatus #DStat!Odd,#R50LD ; bypass logical translation Bcc 10$ ; found LD as a handler NoLErr: Mov #R50LD,R3 ; can't find LD: CK.R3Y=O.Dev Jsr R0,ErrMsg .Word MsgDev ; .DStatus could not find LD Done3: Jmp Done ............ 10$: Mov DStat+D.EntP,LDMem ; save in memory flag value Boff 30$ ; not loaded, then don't do .SPFUN Cmp DStat+D.Stat,#LDSts ; is it the real LD? Bne NoLErr ; no Call 30$ ; purge the channel just in case .LookUp #LukUpL,Code=NoSet ; open LD Bcc 20$ Jsr R0,ErrMsg .Word MsgLuk ; Enter error Br Done3 ............. 20$: .SpFun #SpFunL,WCnt=R5,Code=NoSet Bcc 30$ Jsr R0,ErrMsg .Word MsgSpF ; SpFun error Br Done3 ............. 30$: .Assume Chan EQ 0 .Purge #0 ; done with channel Return ...... .SbTtl Check for valid option values subroutine .Enable LSB CheckV: ; *C* validate option value present ; *C* and range check it Mov (SP)+,R3 ; *C* get return address Mov #-1,R2 ; *C* assume value is missing Bit R0,R0 ; *C* any value? Bmi 10$ ; *C* option value specified Bcc 20$ ; *C* branch if value not required ErNoV1: Jmp ErrNoV ; option value missing -- fatal ............. 10$: Mov (SP)+,R2 ; get value Cmp #.-.,R2 ; in range? LdCMU=:.-2 Bhi 20$ ; yes ***Unsigned compare*** ; R2 MUST contain value for message! Jsr R0,ErrMsg .Word MsgBdV ; option value out of range Br Done3 ; fatal ............. 20$: Mov R3,-(SP) ; restore return address Mov R2,R3 ; copy option value Asl R3 ; make into word index Return ; done ...... .SbTtl Scan the /R or /W option table and set appropriate attribute bit .Enable LSB SetAtt: 10$: Cmp R0,R1 ; out of current options? Bhis 30$ ; branch if yes Mov (R0)+,R3 ; get option value Bpl 20$ ; branch if it is a good unit index MovB UnitA,R3 ; get default unit Asl R3 ; make into valid index Cmp CountL,#1 ; default is valid if exactly 1 /L Bne ErNoV1 ; branch if not exactly 1 /l 20$: Bis R2,Table(R3) ; mark either a /R or /W for this file Br 10$ ; get next occurrence of option ........... 30$: Return .Dsabl LSB .SbTtl Error message formatting routines Device: CK.SP=CkSP CK.R0=M.Subr+2 CK.SP ,-2,CkR1 CK.R3Z O.Dev CK.R3Y O.Dev CK.R3X O.Dev CK.R3W O.Dev CK.R3V O.Dev Mov R1,-(SP) ; and old R1 CK.R0 M.Out,+2 Mov (R0)+,R1 ; get address of buffer CK.SP ,-2,CkR0 Mov R0,-(SP) ; save new R0 value Mov #ErrBuf+2,R0 ; point to string buffer Clr @R0 ; end with zero CK.R3Z O.Dev Mov @R3,@R0 ; get RAD50 for DEV Clr 2(R0) ; truncate at device name Br CalFnA ; join common code .............. File: CK.R3M O.Dev CK.R3N O.Dev CK.R0=M.Subr+2 CK.SPA=CkSP CK.SPA ,-2,CkR1 Mov R1,-(SP) ; save old R1 CK.R0 M.Out,+2 Mov (R0)+,R1 ; get address CK.SPA ,-2,CkR0 Mov R0,-(SP) ; save new R0 value CK.R3M O.Dev Mov R3,R0 ; point to RAD50 DBlk CalFnA: Call $FnAsc ; use ULB routine to convert ClrB (R1)+ ; end string with null Br R01Ret ; restore R0, R1 and return .............. Option: CK.R0=M.Subr+2 CK.R0 M.Out,+2 MovB CkR0E-CK.SPE(SP),@(R0)+ ; plug in option letter Return ...... SwiVal: CK.R0=M.Subr+2 CK.R0 M.Out,+2 MovB CkR0E-CK.SPE(SP),@(R0)+ ; plug in option letter ;;;Value: currently unused CK.SPB=CkSP CK.SPB ,-2,CKR1B Mov R1,-(SP) ; save R1 CK.R0 M.Out2,+2 Mov (R0)+,R1 ; get buffer address CK.SPB ,-2,CkR0B Mov R0,-(SP) ; save new R0 value Mov R1,R0 ; point R0 to buffer Mov R2,R1 ; value to convert CK.SPB ,-2,CkR2B Mov R2,-(SP) ; save R2 Clr R2 ; suppress leading zeros Call $CBOMg ; convert to ascii octal ClrB (R0)+ ; end with null CK.SPB CkR2B,+2 Mov (SP)+,R2 ; restore R2 R01Ret: CK.SPB CkR0B,+2 CK.SP CkR0,+2 Mov (SP)+,R0 ; restore R0 CK.SPB CkR1B,+2 CK.SP CkR1,+2 Mov (SP)+,R1 ; and R1 CK.SPB CkSP CK.SP CkSP Nothin: RtsPC: Return ; used by Physical only requests ...... .SbTtl Messages MsgId: .IIf EQ MMg$T!RTE$M .NLCSI .If NE MMg$T .NLCSI TYPE=I,PART=NAME .Ascii "X " .NLCSI TYPE=Z,PART=RLSVER .EndC .If NE RTE$M .NLCSI TYPE=I,PART=NAME .Ascii "M " .NLCSI TYPE=Z,PART=RLSVER .EndC Prefix: .Ascii "?" .NLCSI TYPE=I,PART=NAME .Ascii "-"<200> M.Subr =: 0 ; subroutine in message block M.Out =: 2 ; subr output pointer M.Out2 =: 4 ; subr 2nd output pointer ; any args for subr are skipped ; by subr, leaving pointer at ; M.Num M.Num =: 2 ; message number M.Levl =: 3 ; error level mask M.Sev =: 4 ; severity level M.Msg =: 5 ; message text Sev.I =: 'I ; Info level Sev.W =: 'W ; Warning level Sev.E =: 'E ; Error level Sev.F =: 'F ; Fatal level Sev.U =: 'U ; Unconditional level ;+ ;ERROR .Even MsgAOK: .Word Nothin ; no message processing .Asciz <-1>"" ; and no message (. is success) .Even MsgCsi: .Word Nothin ; no message processing .Asciz <1>"-Invalid Command" ; ;CSI error ;retry after correcting syntax error ; .Even MsgWRW: .Word Nothin .Asciz <2>"-/W and /R specified for same unit, /W ignored" ; ;/W:n/R:n specified for same n ;retry by selecting the one wanted /W OR /R ; .Even MsgDev: .Word Device,ChrDev .Ascii <3>"-Device not installed " ChrDev: .BlkB 4. ; DEV: .Asciz "" ; ;device name specified has no installed handler ;retry by specifing installed device or installing required device ; .Even MsgRan: .Word Device,ChrRan .Ascii <4>"-Invalid device " ChrRan: .BlkB 4. ; DEV: .Asciz "" ; ;device specified must be random access ;retry is specify a random access device (disk with RT structure) ; .Even MsgNoV: .Word Option,ChrNoV .Ascii <5>"-Option without required value /" ChrNoV: .BlkB 1. ; Option letter .Asciz "" ; ;option requires value, but none supplied ;retry is to specify with a legal value ; .Even MsgPro: .Word File,ChrPro .Ascii <6>"-Unable to protect file " ChrPro: .BlkB 14. ; DEV:FILENA.TYP .Asciz "" ; ;attempted to protect file, but the request failed (directory error?) ;retry is to remove possible write protect of device ; .Even MsgBdV: .Word SwiVal,ChrBdV,ValBdV .Ascii <7>"-Option value out of range (0--" SwtRng: .Ascii "37) /" ChrBdV: .BlkB 1. ; letter .Ascii ":" ValBdV: .BlkB 6. ; value .Asciz "" ; ;option values should be 0-7 (0-37), value specified was out of range ;retry is to do again with valid value ; .Even MsgNoF: .Word Device,ChrNoF .Ascii <8.>"-No file specified " ChrNoF: .BlkB 4. ; DEV: .Asciz "" ; ;specification must include a file name, none given ;retry is to specify file name, not just device name ; .Even MsgFNF: .Word File,ChrFNF .Ascii <9.>"-File not found " ChrFNF: .BlkB 14. ; DEV:FILNAM.TYP .Asciz "" ; ;requested file not found ;verify file really exists ; .Even MsgUkS: .Word Option,ChrUkS .Ascii <10.>"-Unknown option (/C, /L, /R, or /W only) /" ChrUkS: .BlkB 1 ; Letter .Asciz "" ; ;option other than /C/L/R/W was specified ; [/$ and /A options are "hidden", used by DCL only] ;use legal option ; .Even MsgALS: .Word Nothin .Asciz <11.>"-/A requires exactly 1 /L" ; ;/A option works only with 1 /L option ;Use it with 1 /L ; .Even MsgLuk: .Word Nothin .Asciz <12.>"-.LookUp for LD failed" ; ;logic error ;spr ; .Even MsgSpF: .Word Nothin .Asciz <13.>"-.SpFun to LD failed" ; ;logic error ;spr ; .Even MsgWri: .Word Nothin .Asciz <14.>"-Unable to update LD handler" ; ;system device write locked ; and there is no "LOADed" LD handler, changes will NOT happen ;make system device writable ; .Even MsgWWr: .Word Nothin .Asciz <15.>"-Unable to update disk copy of LD handler" ; ;system device write locked ; and there is a "LOADed" LD handler, changes will happen to memory copy ; or no "LOADed" LD handler but /C:-1 (from BOOT or DUP) in which case ; the SET LD CLEAN is a "side-effect" of BOOTing or SQUEEZing ;make system device writable ; .Even MsgHTB: .Word Nothin .Asciz <16.>"-Insufficient memory" ; ;not enough room to fetch required handler ; do "standard" get more memory things ; .Even MsgFet: .Word Device,ChrFet .Ascii <17.>"-.Fetch error " ChrFet: .BlkB 4. ; DEV: .Asciz "" ; ;error return from .FETCH ; std stuff ; .Even MsgSwC: .Word Nothin .Asciz <18.>"-/C not specified alone" ; ;/C must be only option if it is specified ;use it alone ; .Even MsgSwE: .Word Nothin .Asciz <18.>"-/E not specified alone" ; ;/E must be only option if it is specified ;use it alone ; .Even MsgFNs: .Word Nothin .Asciz <19.>"-Invalid nesting" ; ;MOUNT LDm: LDn:filnam.typ when m = n ;the handler will NOT be updated ; .Even MsgWNs: .Word Nothin .Asciz <19.>"-Invalid nesting" ; ;MOUNT LDm: LDn:filnam.typ when m < n ;the handler will be updated ; .Even MsgIRW: .Word Nothin .Asciz <20.>"-/W and/or /R specified for unmounted unit ignored" ; ;/W and/or /R specified for unmounted unit ;retry by specifying /W and/or /R only for units being mounted ;or already mounted ; .Even MsgV2M: .Word Nothin .Asciz <21.>"-Too many /W and/or /R options" ; ;expand space for temporary storage of /W and /R option values ;spr ; .Even MsgGFS: .Word File,ChrGFS .Ascii <22.>"-.GFSta failed " ChrGFS: .BlkB 14. ; DEV:FILENA.TYP .AsciZ "" ; ;failed .GFSta ;? impossible because of previously successful .LookUp ? ;- .Even .SbTtl Data Chan =: 0 ; work channel SysChn =: 17 ; system "overlay" channel ..LDEX:: ; label for feature patch DefExt: .Word Def$LD,Def$LD,Def$LD,Def$LD ; default extensions table R50LD: ; LD: non-file-structured .RAD50 /LD/ ; NOTE: this is the "device" name .Word 0 ; of LD, not it's "handler" name. LimLow: .Limit LimHi =: LimLow+2 ACmnd: .Ascii "$ASSIGN LD" ; $ASSIGN LD_ prototype command UnitA: .BlkB 1. .Asciz " " LCmnd: .Asciz "$LOAD " .Even SwList: SwEOL =: 0 SwLtr =: 1 SwSubr =: 2 SwLeng =: 4 .Byte 0,Swt.$ .Word Swt$ .Byte 0,Swt.A .Word SwtA .Byte 0,Swt.C .Word SwtC .Byte 0,Swt.E .Word SwtE .Byte 0,Swt.L .Word SwtL .Byte 0,Swt.R .Word SwtR .Byte 0,Swt.W .Word SwtW SwLEnd =: -1 ; terminator value .Byte SwLEnd .SbTtl EMT argument blocks .LookUp =: 1 ; .LookUp subcode .Write =: 11 ; .Writ_ subcode .CStat =: 27 ; .CStat subcode .SpFun =: 32 ; .SpFun subcode .FProt =: 43 ; .FProt subcode .GFSta =: 44 ; .GFSta subcode Protect =: 1 ; code for file protect Physical=: RtsPC+1 ; bypass logical search .Even CStatF: .Byte Chan, .CStat .Word CStat CStatS: .Byte SysChn, .CStat .Word CStat FProt: .Byte Chan, .FProt .BlkW 1. .Word Protect .Word Physical GFStat: .Byte Chan, .GFSta .BlkW 1 ; addr(dblk) .Word 0 ; filler .Byte 0 ; filler .Byte 0 ; E.Stat .Word Physical ; bypass logical device search LukUpF: .Byte Chan, .LookUp .BlkW 1. ; Made odd if /C .Word 0 .BlkW 1 ; filler .Word Physical ; bypass logical device search LukUpL: .Byte Chan, .LookUp .Word R50LD!Odd .Word 0 .BlkW 1 ; filler .Word Physical ; bypass logical device search LukUpS: .Byte SysChn, .LookUp .Word DBlock!Odd .Word 0 .BlkW 1 ; filler .Word Physical ; bypass logical device search SpFunL: .Byte Chan, .SpFun .Word 0 .Word BufLow .BlkW 1. .Byte 377, Upd$Fn .Word 0 WritW: .Byte SysChn, .Write .Word LDStrt/WdsBlk/2 .Word LDStrt .Word WdsBlk*2 ;**** WRITE 2 BLOCKS **** .Word 0 .SbTtl Area to clear on startup ClrLow: ErrBuf: .BlkW 2. ; buffer for error message formatting Flag$: .BlkW 1. ; 0<> doing /$ (DCL) FlagC: .BlkW 1. ; 0<> doing /C FlgNoC: .BlkW 1. ; 0<> doing non-/C FlagE: .BlkW 1. ; 0<> doing /E FlgNoE: .BlkW 1. ; 0<> doing non-/E ValueA: .BlkW 1 ; 0<> /A specified, value is ; Rad50 for /A value ValueC: .BlkW 1 ; value for /C CountL: .BlkW 1 ; number of /Ls encountered RValsP: .BlkW 1 ; ptr to current /R option value WValsP: .BlkW 1 ; ptr to current /W option value RVals: .BlkW 40. ; area for storing /R and /W WVals: ; option values IgnrRW: .BlkW 1. ; 0<> warn /R or /W on unmounted unit WarnRW: .BlkW 1. ; 0<> warn about /R/W WarnNs: .BlkW 1 ; 0<> nesting error NsWarn =: 1 ; warning level NsErr =: -1 ; fatal level LDMem: .BlkW 1. ; 0<> LD is LOADed HadErr: .BlkW 1. ; 0<> error had occurred FetErr: .BlKW 1 ; 0<> had fetch error CmdPtr: .BlkW 1. ; next free byte on command buffer CmdCnt: .BlkW 1. ; number of bytes in use DBlock =: ChnTo ; CSI block .IRpC .....1 <123> Out'.....1: .BlkW 5. .EndR .IRpC .....1 <123456> In'.....1: .BlkW 4. .EndR .If GT LD$UNI-9. .Rept LD$UNI-9. .BlkW 4. .EndR .EndC O.Dev =: 0 ; device name offset O.Name =: 2 ; file name offset O.Type =: 6 ; file type offset O.Leng =: 10 ; length of DBlk O.Size =: 10 ; output file size offset DStat: .BlkW 4. ; DSTATUS buffer D.Stat =: 0 ; status offset D.HSiz =: 2 ; handler size offset D.EntP =: 4 ; memory address offset D.DSiz =: 6 ; device size offset CStat: .BlkW 6. ; CSTATUS buffer C.CSW =: 0 ; CSW offset C.SBlk =: 2 ; begin block offset C.Leng =: 4 ; size in blocks offset C.Used =: 6 ; highest block written C.Unit =: 10 ; unit number C.DevN =: 12 ; handler physical name Table: .BlkW LD$UNI ; temp data from CSI ; reformatted for processing T.Leng =: 2 ; length of an entry Sw.L =: 100000 ; /L present for this unit Sw.R =: 040000 ; /R ... Sw.W =: 000100 ; /W ... .Assume Sw.L EQ Ld.Act ; Handlr used as Table for /C .Assume Sw.R EQ Ld.RdO ; Handlr used as Table for /C CmdBuf: .BlkB 100. ; input/output command buffer .Even ClrHi: .End LDRun ; "Run" entry point