.MCALL .MODULE .MODULE IGTDUS,VERSION=21,COMMENT=,IDENT=NO,LIB=YES ; 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 Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 16-OCT-90 Standardize PSECT names. Also, ; contribute SV.NID to the absolute ; PSECT to prevent loading in ; a separated I&D environment. At ; present, there is a problem with ; JSR R4,X/.WORD Y sequences. ; ; 002 WLD 31-OCT-90 Eliminate JSR R4,X/.WORD Y ; sequences. Replace with: ; MOV #Y,R3 ; JSR PC,X ; Eliminate SV.NID contribution to ; the absolute PSECT. ;-- .SBTTL IGTDUS - FORTRAN callable subroutine ;+ ; IGTDUS(IDEVNAM,ICHAN,ISTAT[,IUNIT][,ITYPE][,IWORK][,ISIZE]) ; ; The following routine returns the status of the desired MSCP ; unit. The user provides the RAD50 device name, a channel to ; perform the operation. The unit number specified can be the ; RT-11 unit or the MSCP unit which has been mapped to the ; corresponding RT unit. A work area can be supplied for the ; routine to use. The information returned includes, status ; of the drive, size of the drive, media type and drive flags. ; If IUNIT is omitted, the unit specified by IDEVNAM is used. ; ; ERRORS ARE POSSIBLE. ; ; 0 Normal return ; -1. Logic error (table .SPFUN 0) ; -2. Logic error (table .SPFUN 1) ; -3. Logic error (table .SPFUN 2) ; -4. Logic error (Bypass .SPFUN 0) ; -5. Hard error (Bypass .SPFUN 1) ; -6. Logic error (Bypass .SPFUN 2) ; -7. Insufficient Work Area ; -8. reserved ; thru ; -12. reserved ; -13. Handler not loaded (.DStat) ; -14. Handler not installed in system (.DStat) ; -15. Channel in use (.Lookup 0) ; -16. Logic error (.Lookup 1) ; -17. Device in use and not sharable (.Lookup 2) ; -18. Device does not support MSCP (not DU, MU) ; -19. First char of ITYPE argument not "M" or "R" ; -20. Logic error (.Lookup 5 - Invalid Seq No.) ; -21. Invalid Unit Number (.Lookup 6) ; -22. reserved ; -23. Required argument is missing (IDEVNAM,ICHAN,ISTAT) ; ; -129. same as IGETR ; and above ;- .IIF NDF EIS$I EIS$I=0 .MCALL .BR .ASSUME .CKXX .SERR .HERR .DSTAT .CLOSE .IIF EQ EIS$I .MCALL SOB .LIBRARY "SRC:SYSTEM.MLB" ;.%%%DF library .MCALL .SAVDF ;>>> .MCALL .ZDUDF ;DU layout ;>>> .ZDUDF ;>>> .MDELETE .ZDUDF ;>>> remove the following to next ;>>> when above uncommented DU.ID =: 0 DU.IDV =: ^rDU DU.NUM =: 2 DU.ENT =: 4 DU.UNI =: 0 DU.PAR =: 2 DU.POR =: 3 DU.ESZ =: 4 ;>>> .CKXX .GLOBL $NXADR $NXVAL $ERRM0 .GLOBL $SYSLB .MACRO ...... .ENDM ERRBYT =: 52 ; EMT error BYTE ; EMT codes .CSTAT =: 375 ; EMT code for .CSTAT CSTAT. =: 27 ; EMT subcode for .CSTAT .LOOKU =: 375 ; EMT code for .LOOKUP LOOKU. =: 1 ; EMT subcode for .LOOKUP .SPFUN =: 375 ; EMT code for .SPFUN SPFUN. =: 32 ; EMT subcode for .SPFUN ; SPFUN codes SF.BYP =: 360 ; Bypass SPFUN code SF.TAB =: 372 ; Translation table SPFUN code ; MSCP communication area M.AREA =: 52. ; MSCP area length in words RSPLEN =: 48. ; Length of response area in bytes CMDLEN =: 48. ; Length of command area in bytes M.VID =: 0 ; MSCP virtual circuit id value M.RBYT =: 0 ; Offset of response pkt length word M.RVID =: 2 ; Offset of response VC ID M.RSPP =: 4 ; Offset of 1st byte of response pkt M.CBYT =: M.RSPP+RSPLEN ; Offset of command pkt length word M.CVID =: M.CBYT+2 ; Offset of command VC ID M.CMDP =: M.CVID+2 ; Offset of 1st byte of command pkt ; Command packet offsets (CMDLEN) P.CRF =: 0 ; Command reference number P.UNIT =: 4 ; MSCP unit number P.OPCD =: 10 ; Opcode OP.RD =: 41 ; Read command OP.WR =: 42 ; Write command OP.ONL =: 11 ; Online command OP.GUS =: 03 ; Get unit status P.MOD =: 12 ; Modifiers P.BCNT =: 14 ; Byte count ; P.UNFL =: 16 ; Unit flags P.DEVD =: 34 ; Device dependent parameters P.BUFF =: 20 ; Buffer descriptor P.LBN =: 34 ; Logical block number P.PART =: 36 ; High order LBN P.CSIZ =: 60 ; 48. bytes (total length; 24 words) ; Response offsets (RSPLEN) P.STS =: 12+4 ; Offset to status flags P.OFLN =: 43 ; Status=Unit offline (unmounted/disabled) P.UNFL =: 16+4 ; Offset to unit flags P.MEDI =: 34+4 ; Media type identifyer P.UNSZ =: 44+4 ; Unit size ; Status masks M.STS =: 37 ; Status mask M.FLG =: 120200 ; Unit flag mask ; Flag definitions UF.RMV =: 200 ; Removable media UF.RPL =: 100000 ; Controller initiated bad block replacement ; MSCP device codes DEV.DU =: 50 ; Device ID for DU.SYS DEV.MU =: 60 ; Device ID for MU.SYS ;+ ; Work Area Size Definitions and Information ; ------------------------------------------ ; ; IGTDUS uses the work area for processing EMTs and for storing local ; variables. Most EMT arguments are stored in the work area, including ; the MSCP command and response packet and the buffer into which the ; handler translation table is read. The EMT channel argument is always ; located at offset 4 in the work area. Most other EMT arguments and ; the objects of EMT argument pointers follow. An exception to this rule ; is the object of the DEVNAM argument which is located at offset 0 in ; the work area. ; ; The MSCP command and response packets require the largest amount of ; space in the work area. This structure begins at work area offset 16. ; and continues to work area offset 120. This leaves work area offsets ; 120. through 160. available for use as needed for additional EMT argu- ; ments or as local variables for IGTDUS. In general, local variables ; stored in this area are those which must be preserved across the execu- ; tion of one or more EMT service routines. ; ; Note: This SYSLIB makes no references to FORTRAN OTS modules or data ; structures. It may be used in any language environment, provided that ; the PDP-11 FORTRAN subroutine calling convention is followed. ;- W.SIZE =: 80. ; Minimum size of work area (words) W.MIN =: W.SIZE*2 ; (same in bytes) GTDS$W ==: W.SIZE ; Global definition ; FORTRAN argument offsets NOARG = -1 ; Omitted arg addr value F.ARGS =: -2 ; No. of arguments F.DEV =: 0 ; RAD50 device name F.CHAN =: 2 ; Channel F.STAT =: 4 ; Status R.STAT =: 0 ; Status word R.FLAG =: 2 ; Flag word R.SIZE =: 4 ; Size (INTEGER*4) R.IDEN =: 10 ; Ident String (BYTE*6 ASCIZ) F.UNIT =: 6 ; Unit number F.TYPE =: 10 ; Type of unit T.RT =: 'R ; RT-11 T.MSCP=: 'M ; MSCP F.WORK =: 12 ; Work area W.BASE =: 0 ; Base of the work area W.DBLK =: 0 ; DBLK for device W.FILE =: 2 ; File name in DBLK (0) W.EMT =: 4 ; EMT request area W.CHAN =: W.EMT+0 ; Channel number W.EMTC =: W.EMT+1 ; EMT code W.LDBK =: W.EMT+2 ; Lookup DBLK arg W.LSEQ =: W.EMT+4 ; Lookup SEQNUM arg W.CBUF =: W.EMT+2 ; CStatus reply area address W.SBLK =: W.EMT+2 ; SPFUN BLK arg W.SBUF =: W.EMT+4 ; SPFUN BUF arg W.SWCT =: W.EMT+6 ; SPFUN WCNT arg W.SFUN =: W.EMT+10 ; SPFUN FUNC arg W.SRTN =: W.EMT+12 ; SPFUN CRTN arg W.DNAM =: W.EMT+14 ; .CSTAT 6th return word ; Work area offsets of locations which must be preserved across EMT calls. W.PART =: W.EMT+16 ; Storage for unit's partition W.DSID =: W.PART+1 ; Storage for device id (ODD) W.SHER =: W.DSID+1 ; Storage for original .SERR value W.SPAC =: W.SHER+2 .ASSUME EQ 0 W.NEXT =: W.SPAC+2 ; Next offset definition may be here. F.SIZE =: 14 ; Size argument offset ; CSTATUS reply area C.CSW =: 0 ; CSW C.BEG =: 2 ; Beginning block C.LEN =: 4 ; Length C.HWM =: 6 ; Highest block written C.UNIT =: 10 ; Unit number C.PDEV =: 12 ; Physical device name ; DSTATUS reply area D.DEV =: 0 ; Device code (byte) D.STAT =: 1 ; Device characteristics (byte) D.HSIZ =: 2 ; Handler size D.HLOA =: 4 ; Handler load addr D.VSIZ =: 6 ; Device size ; Miscellaneous UCASE =: 'a-'A ; Mask to uppercase an alpha char ; Initial values for CK.XX macros X.UNIT =: 125252 ; Arbitrary value for unit register test X.TYPE =: 52525 ; Arbitrary value for type register test ; .SERR error codes ER.DIO =: 375 ; Error doing directory I/O ; Error codes SUCCES =: 0 ; Normal return ERSPFT =:0 ; Offset value for table .SPFUN errors ; -1. ; Logic error (table .SPFUN 0) ; -2. ; Logic error (table .SPFUN 1) ; -3. ; Logic error (table .SPFUN 2) ERSPFB =:3 ; Offset value for bypass .SPFUN errors ; -4. ; Logic error (Bypass .SPFUN 0) ILHARD =:-5. ; Hard error (Bypass .SPFUN 1) ; -6. ; Logic error (Bypass .SPFUN 2) INSUFW =:-7. ; Insufficient work area ; -8. ; reserved ; thru ; -12. ILLOAD =:-13. ; Handler not loaded (.DStat) ILNOHD =:-14. ; Handler not installed in system (.DStat) ERLOOK =:14. ; Offset value for .LOOKUP errors ; -15. ; Channel in use (.Lookup 0) ; -16. ; Logic error (.Lookup 1) ; -17. ; Device in use and not sharable (.Lookup 2) ILMSCP =:-18. ; Device does not support MSCP (not DU,MU) ILTYPE =:-19. ; First char of ITYPE argument not "M" or "R" ; -20. ; Logic error (.Lookup 5 Invalid Seq No.) INVUNT =:-21. ; Invalid Unit Number (.Lookup 6 magtape) ; -22. ; Reserved ILLARG =:-23. ; Required arg missing (IDEVNAM,ICHAN,ISTAT) .SBTTL IGTDUS - Entry Point ;+ ; Entry point of routine ;- .PSECT SYS$I,I .ENABL LSB CK.R5=F.ARGS GTDUS:: IGTDUS:: CK.R5 F.ARGS,+2 MOV (R5)+,R4 ; R4 = No. of arguments MOV #W.MIN,R0 ; default work area size CMPB R4,# ; was SIZE supplied? BLT 10$ ; branch if not MOV F.SIZE(R5),R1 ; Get its address CMP R1,#NOARG ; no argument after comma? BEQ 10$ ; branch if no argument MOV @R1,R0 ; get specified size (words) ASL R0 ; make it bytes 10$: CMP R0,#W.MIN ; adequate work area? BGE 20$ ; branch if so. INSUF: MOV #INSUFW,R0 ; Insufficient Work Area RETURN ; Exit with error. ...... 20$: CMPB R4,# ; Is the WORK arg present BLT 30$ ; No, then use stack for work area CK.R5 0 MOV F.WORK(R5),R3 ; R3 -> Work area CK.R3A=W.BASE CMP #NOARG,R3 ; Is it a valid address? BEQ 30$ ; No, then use stack ... CLR -(SP) ; Save "no" stack adjust value BR 40$ ; Get rest of args ...... ; Use the stack as a work area. Allocate space by moving SP down ; by the number of bytes specified in R0. Then put R0 on the stack ; for later restoration. 30$: SUB R0,SP ; Reserve the area required MOV SP,R3 ; R3 -> Work area CK.R3B=W.BASE MOV R0,-(SP) ; Save stack adjust value used on exit 40$: MOV R0,W.SPAC(R3) ; Save size of work area .Assume CK.R3A EQ CK.R3B CK.R3=CK.R3A MOV R3,R1 ; Copy work area pointer CK.R1=CK.R3 CK.R5 F.DEV,+2 CALL $NXVAL ; Get DEVNAM BCS 50$ ; Required argument missing CK.R1 W.DBLK,+2 MOV R0,(R1)+ ; Put in work area CK.R1 W.FILE, +2 CLR (R1)+ ; And clear next word for NFS open CK.R5 F.CHAN,+2 CALL $NXADR ; Get the addr of CHAN BCS 50$ ; Required argument missing CK.R1 W.CHAN,+1 MOVB @R0,(R1)+ ; Put CHAN in work area CK.R1 W.EMTC,+1 CLRB (R1)+ ; Clear EMT request code area CK.R5 F.STAT,+2 CALL $NXADR ; Get the addr of STAT BCC 60$ 50$: MOV #ILLARG,R0 ; Required argument missing CIAO2: BR CIAO1 ; send error ...... CK.R0=F.STAT 60$: MOV R0,R2 ; Save STAT address CK.R2=CK.R0 MOV #NOARG,R0 ; Assume no UNIT CK.R5 F.UNIT,+2 CALL $NXVAL ; Get the UNIT value, if any MOV R0,R1 ; Save UNIT value or "missing" value CK.R1=X.UNIT MOVB #T.RT,R0 ; Default TYPE is "RT11" CK.R5 F.TYPE,+2 CALL $NXADR ; Get the addr of TYPE BCS 70$ ; Not supplied MOVB @R0,R0 ; Get value BICB #UCASE,R0 ; Uppercase it CK.R5=CK.R3 70$: MOV R3,R5 ; Copy work area pointer to perm reg CK.R4=CK.R2 MOV R2,R4 ; Copy STAT pointer to perm register MOV R0,R2 ; Copy TYPE to safe register CK.R2=X.TYPE .BR $DEVCK ; Check out the device .DSABL LSB .SBTTL $DEVCK - Check for valid RT-11 device ;+ ; Check if device is valid. ;- ; At this point: ; R0 free ; R1 UNIT save ; R2 TYPE save ; R3 WORK available on exit ; R4 STAT save ; R5 WORK save ; 0(R5) DEVNAM save ; 2(R5) 0 available on exit ; 4(R5) CHAN save ; 6(R5)+ free .ENABL LSB $DEVCK: CK.R3 ,+W.EMTC+3 ADD #W.EMTC+3,R3 ; skip first part of EMT area .Assume CK.R3 GT W.EMTC CK.R3 ,,DBUFF .DSTAT R3,R5 ; Get device status BCC 10$ ; Branch if no error MOV #ILNOHD,R0 ; (invalid device) BR CIAO1 ; Go process error ...... CK.R3 DBUFF 10$: CMPB #DEV.DU,@R3 ; Is it DU? BEQ 20$ ; Yes CK.R3 DBUFF CMPB #DEV.MU,@R3 ; Is it MU? BNE 30$ ; No, invalid device CK.R5 W.BASE 20$: MOVB @R3,W.DSID(R5) ; Save ID for later CK.R3 DBUFF TST D.HLOA(R3) ; Is it in memory? BNE $OPEN ; Yes MOV #ILLOAD,R0 ; Unloaded driver BR CIAO1 ; process it ...... 30$: MOV #ILMSCP,R0 ; not an MSCP device CIAO1: JMP CIAO ...... .DSABL LSB .SBTTL $OPEN - Open a channel to the device ;+ ; Open Channel ;- ; At this point: ; R0 free ; R1 UNIT save ; R2 TYPE save ; R3 free ; R4 STAT save ; R5 WORK save ; 0(R5) DEVNAM save ; 2(R5) 0 available ; 4(R5) .lookup!CHAN save chan part ; 6(R5)+ available .ENABL LSB $OPEN: .SERR ; ask for soft errors CK.R5 W.BASE MOVB R0,W.SHER(R5) ; store the old I.SERR value MOV R5,R3 ; point to work area CK.R3=CK.R5 CK.R3 ,+2+2 CMP (R3)+,(R3)+ ; point to EMT request area CK.R3 W.EMT MOV R3,R0 ; Setup R0 for EMT call CK.R0=CK.R3 .Assume CK.R3+1 EQ W.EMTC CK.R3 W.EMT,+2 BIS #LOOKU.*400,(R3)+ ; Store request code CK.R5 W.BASE CK.R3 W.LDBK,+2 MOV R5,(R3)+ ; Store DBLK addr CK.R3 W.LSEQ,+2 MOV #-1,(R3)+ ; set seq number for NO_REWIND .Assume CK.R0 EQ W.EMT .Assume W.EMT EQ W.CHAN .Assume W.CHAN+1 EQ W.EMTC .Assume W.EMTC+1 EQ W.LDBK .Assume W.LDBK+2 EQ W.LSEQ EMT .LOOKUP ; Open device as NFS BCC 10$ MOVB @#ERRBYT,-(SP) ; Store lookup error for later CALL RSHERR ; Restore old I.SERR value MOVB (SP)+,@#ERRBYT ; Restore lookup error SEC ; set error flag JMP ERRM14 ; Go process error exit 10$: CALL RSHERR ; Restore old I.SERR value 20$: .BR $TYPEU ; Go do device check .DSABL LSB .SBTTL $TYPEU - Check device type ; At this point: ; R0 free ; R1 UNIT save ; R2 TYPE save ; R3 past the EMT request area available ; R4 STAT save ; R5 WORK save ; 0(R5) DEVNAM available ; 2(R5) 0 available ; 4(R5) .lookup!CHAN save chan part ; 6(R5)+ available .ENABL LSB CK.R5 W.BASE $TYPEU: CLRB W.PART(R5) ; Clear partition byte CK.R2 X.TYPE CMPB #T.MSCP,R2 ; Is it an MSCP unit? BEQ $GSTAT ; Yes, go get status CK.R2 X.TYPE CMPB #T.RT,R2 ; Is it an RT unit? BEQ 10$ ; Yes MOV #ILTYPE,R0 ; First char of the char arg invalid JMP ERRPRO ...... 10$: CK.R1 X.UNIT TST R1 ; Was unit number supplied? .Assume NOARG LT 0 BPL 20$ ; yes - no need to do CSTAT to get ; the unit number then... CK.R5 W.BASE CK.R3=CK.R5 MOV R5,R3 ; Copy work pointer CK.R3 ,+2+2 CMP (R3)+,(R3)+ ; Skip to EMT area CK.R3 W.EMT MOV R3,R0 ; Setup R0 for EMT CK.R0=CK.R3 .Assume <!> EQ .Assume CK.R3+1 EQ W.EMTC CK.R3 W.EMT,+2 BIS #CSTAT.*400,(R3)+ ; Change LOOKUP to CSTAT CK.R3 W.CBUF CK.R3 ,,CBUFF MOV R3,@R3 ; Point to answer area ; overlaying EMT area, but that's ok .Assume CK.R0 EQ W.EMT .Assume W.EMT EQ W.CHAN .Assume W.CHAN+1 EQ W.EMTC .Assume W.EMTC+1 EQ W.CBUF EMT .CSTAT ; get channel status CK.R3 CBUFF CK.R1 X.UNIT MOV C.UNIT(R3),R1 ; get unit number CK.R5 W.BASE 20$: CMPB #DEV.MU,W.DSID(R5) ; is this MU? BEQ $GSTAT ; yes, no translation .BR $TABCK ; Translate to MSCP unit .DSABL LSB .SBTTL $TABCK - Get MSCP Translation Table ;+ ; Get translation table ;- ; At this point: ; R0 free ; R1 UNIT save ; R2 free ; R3 past the EMT request area available ; R4 STAT save ; R5 WORK save ; 0(R5) DEVNAM available ; 2(R5) 0 available ; 4(R5) .CSTAT!CHAN save chan part ; 6(R5)+ CSTAT reply available .ENABL LSB $TABCK: ; Check here for adequate work area space. MOV R1,R2 ; Get UNIT number, ASL R2 ; required WORDS, ASL R2 ; required BYTEs in trans. table ADD #<2+4+W.NEXT>,R2 ; required BYTEs in work area CMP R2,W.SPAC(R5) ; was that much supplied? BLOS 20$ ; branch if yes. MOV #INSUFW,R0 ; otherwise, error. 10$: JMP ERRPRO ; (.CLOSE channel first) ...... 20$: SUB #W.NEXT,R2 ; make WCNT arg value ; Perform .SPFUN 372 to get the translation table MOV #,R3 CK.R5 W.BASE CK.R3=CK.R5 CALL SETUP ; setup table-read .SPFUN CK.R3 ,+30 .Assume CK.R0 EQ W.EMT .Assume W.EMT EQ W.CHAN .Assume W.CHAN+1 EQ W.EMTC .Assume W.EMTC+1 EQ W.SBLK .Assume W.SBLK+2 EQ W.SBUF .Assume W.SBUF+2 EQ W.SWCT .Assume W.SWCT+2 EQ W.SFUN .Assume W.SFUN+2 EQ W.SRTN EMT .SPFUN ; Do the .SPFUN BCC 30$ ; Branch if no error JMP ERRM0 ...... CK.R1 X.UNIT 30$: MOV #ILHARD,R0 ; In case of error, CK.R3 SBUFF CMP R1,DU.NUM(R3) ; Does the table include our unit? BHIS 10$ ; Error if not. 40$: ASL R1 ; UNIT*2 ASL R1 ; *4 Offset into translation table CK.R3 SBUFF ADD R3,R1 ; Point to MSCP unit .Assume DU.ENT EQ 2+2 CMP (R1)+,(R1)+ ; Account for DU.ID and DU.NUM .Assume DU.UNI EQ 0 CK.R5 W.BASE MOVB 2(R1),W.PART(R5) ; Store partition for calculating ; the size later. MOV (R1)+,R1 ; R1 = MSCP unit number CK.R1=X.UNIT .BR $GSTAT .DSABL LSB .SBTTL $GSTAT - Get Status ;+ ; Do Get Status ;- ; At this point: ; R0 free ; R1 UNIT ; R2 free ; R3 past the EMT request area ; R4 STAT ; R5 WORK ; 0(R5) DEVNAM ; 2(R5) 0 ; 4(R5) .SPFUN!CHAN $GSTAT: ; Bring drive ON_LINE MOV #OP.ONL,R3 CK.R4 F.STAT CK.R4=R.STAT CALL BYPASS ; Use bypass .SPFUN ; to try to put unit online CK.R3 MBUFF CK.R4 R.STAT ; Save size values in user's variables MOV P.UNSZ(R3),R.SIZE-R.STAT(R4) ; Low word CK.R3 MBUFF CK.R4 R.STAT MOV P.UNSZ+2(R3),R.SIZE+2-R.STAT(R4) ; High word ; GET_UNIT_STATUS MOV #OP.GUS,R3 CALL BYPASS ; Use bypass .SPFUN ; to get unit status BCS ERRM3 ; Branch because of hard error .BR $REPOR ; Or drop through and generate report .SBTTL $REPOR - Format results in user buffer ;+ ; This routine will generate the seven word report for the user. ;- .ENABL LSB $REPOR: ; Generate status... CK.R3 MBUFF MOV P.STS(R3),R0 ; Get status MOV R0,R1 ; Save complete status CK.R2A=2 CK.R2B=2 CK.R2C=2 MOV #2,R2 ; Assume error number 2 BIC #^C,R0 ; Unit online ? CK.R2A 2 BEQ 20$ ; Yes, status 0 CMP #4,R0 ; Available? CK.R2B 2 BEQ 30$ ; Yes, status 1 CMP #3,R0 ; Offline? BNE 10$ ; No, hard error CMP #P.OFLN,R1 ; Offline - no volume mounted? CK.R2C 2 BEQ 40$ ; Yes, status 2 10$: MOV #ILHARD,R0 ; Indicate hard error BR ERRPRO ; Go process error ...... CK.R2A 2 20$: DEC R2 ; Indicate ON_LINE CK.R2A 1,-1 CK.R2B 2 30$: DEC R2 ; Indicate AVAILABLE CK.R2A 0,-1 CK.R2B 1,-1 CK.R2C 2 CK.R4 R.STAT,+2 40$: MOV R2,(R4)+ ; Indicate OFF_LINE ; Generate unit flags CK.R3 MBUFF CK.R4 R.FLAG 50$: MOV P.UNFL(R3),@R4 ; @R4 flags CK.R4 R.FLAG,+2 BIC #^C,(R4)+ ; Mask unnecessary info in user buffer CK.R5 W.BASE CMPB #DEV.MU,W.DSID(R5) ; TMSCP device? BNE 60$ ; branch if no ; MU-specific status... CK.R4 ,-2 BIS #UF.RMV,-(R4) ; TMSCP devices are always removable CK.R4 R.FLAG,+2 BIC #UF.RPL,(R4)+ ; and don't support bad block ; replacement. CK.R4 R.SIZE,+2 MOV #-1,(R4)+ ; For TMSCP: the size field is CK.R4 ,+2 MOV #-1,(R4)+ ; undefined. Make both words BR 70$ ; equal to -1. ...... ; DU-specific status... 60$: CK.R5 W.BASE CK.R4 ,-4 MOVB W.PART(R5),R0 ; For MSCP: Return the size of CK.R4 R.SIZE,+2 TST (R4)+ ; the volume minus the base of CK.R4 ,+2 SUB R0,(R4)+ ; the current partition. ; DU and MU: Get media identifier CK.R3 MBUFF 70$: MOV P.MEDI(R3),R2 ; low word ; R0 = ddddeeeeennnnnnn CK.R3 MBUFF MOV P.MEDI+2(R3),R1 ; high word ; R1 = aaaaabbbbbcccccd MOV R2,-(SP) ; Make a copy ; R2 = ddddeeeeennnnnnn ROR R1 ; Move first char to bottom of high ; R1 = ?aaaaabbbbbccccc [d] ROR R2 ; R2 = dddddeeeeennnnnn [n] MOV R1,R0 CK.R4 R.IDEN,+1 CALL ALPHA ; Store first character ROR R2 ; shift high bit from low part ; R2 = ?dddddeeeeennnnn [n] ROR R2 ; shift high bit from low part ; R2 = ??dddddeeeeennnn [n] ROR R2 ; shift high bit from low part ; R2 = ???dddddeeeeennn [n] MOV R2,R1 ; make a copy ; R1 = ???dddddeeeeennn [n] SWAB R2 ; move to the bottom ; R2 = eeeeennn???ddddd MOV R2,R0 CK.R4 R.IDEN+1,+1 CALL ALPHA ; store second character ROR R1 ; R1 = ????dddddeeeeenn [n] ROR R1 ; R1 = ?????dddddeeeeen [n] ROR R1 ; R1 = ??????dddddeeeee [n] MOV R1,R0 CK.R4 R.IDEN+2,+1 CALL ALPHA ; Store third character MOV (SP)+,R0 ; get P.MEDI BIC #^C<177>,R0 ; R0 = 7-bit media number ; R0 = 000000000nnnnnnn CALL DECIMA ; Go convert the two numbers CK.R4 R.IDEN+3,+1 MOVB R1,(R4)+ ; Store first digit CK.R4 R.IDEN+4,+1 MOVB R2,(R4)+ ; Store next... CK.R4 R.IDEN+5,+1 CLRB (R4)+ ; and make into ASCIZ CLR R0 ; Successful exit value BR ERRPRO ; Go exit ...... .DSABL LSB .ENABL LSB ERRM14: MOV #ERLOOK,R4 ; Offset value for LOOKUP errors BR 10$ ; determine error, return to user ...... ERRM3: CK.R3 MBUFF CMP #P.OFLN,P.STS(R3) ; Offline for a good reason? BEQ $REPOR ; Yes, report characteristics anyway MOV #ERSPFB,R4 ; Offset value for SPFUN bypass errors 10$: CALL ERCO ; determine error code BR ERRPRO ; .CLOSE and return to user .Assume ERSPFT EQ 0 ERRM0: CALL $ERRM0 ; make error code negative ERRPRO: MOV R0,-(SP) ; Save error code, CK.R5 W.BASE .CLOSE W.CHAN(R5) ; close the channel if open MOV (SP)+,R0 ; Restore error code CIAO: ADD (SP)+,SP ; Restore the stack! RETURN ; to user. ...... .DSABL LSB .SBTTL Local Service Routines .SBTTL ERCO - Ensure negative return code if error ; ERCO is a local subroutine. It saves the current ERRBYT value in R0, ; and ensures that it is negative. .ENABL LSB ERCO: MOVB @#ERRBYT,R0 ; Get error byte value BMI 80$ ; SERR value, just do it ADD R4,R0 ; Offset the error byte value COM R0 ; and make it negative RETURN ...... 80$: CALLR $ERRM0 ; make code negative and RETURN. ...... .SBTTL ALPHA - Translate 5-bit value to ASCII character ; ALPHA translates a value in R0 to an alphabetic character. ; A value of ZERO is translated to the SPACE character. ALPHA: BIC #^C<37>,R0 ; mask low 5 bits of alpha value BNE 100$ SUB #40,R0 100$: ADD #100,R0 MOVB R0,(R4)+ ; store character in user buffer RETURN ...... .DSABL LSB .SBTTL BYPASS - Interface with MSCP Handler's BYPASS ;+ ; Use BYPASS SPFUN to 1) bring drive ON_LINE, and 2) GET_UNIT_STATUS ; ; Calling Sequence: ; ; ; ; CALL BYPASS ; (RETURN) ; ; ; ; ; ; ; ;- .ENABL LSB BYPASS: CLR R2 ; WCNT=0 MOV R3,-(SP) ; Save op code passed. MOV #,R3 CK.R5 W.BASE CK.R3=CK.R5 CALL SETUP ; Build EMT block CK.R3 ,+30 ; Start building the MSCP command/response block CK.R3 W.NEXT STEMP=CK.R0 MOV R0,-(SP) ; Save R0 around clear loop CK.R0=CK.R3 MOV R3,R0 ; Copy pointer MOV #M.AREA,R2 ; R2 = size of MSCP block (to clear) 10$: CLR (R0)+ ; Clear location SOB R2,10$ MOV (SP)+,R0 ; Restore R0 CK.R0=STEMP MOV R3,R2 ; Copy pointer to MSCP area CK.R2=CK.R3 CK.R2 MBUFF,+2 MOV #RSPLEN,(R2)+ ; Store length of response area CK.R2 MBUFF+M.RVID,+2 MOV #M.VID,(R2)+ ; Store virtual circuit id CK.R2 MBUFF+M.RSPP,+RSPLEN ADD #RSPLEN,R2 ; Point to start of command CK.R2 MBUFF+M.CBYT,+2 MOV #CMDLEN,(R2)+ ; Store length of command area CK.R2 MBUFF+M.CVID,+2 .Assume M.VID EQ 0 CLR (R2)+ ; Store virtual circuit id CK.R1 X.UNIT CK.R2 MBUFF+M.CMDP,+2 MOV R1,P.UNIT(R2) ; Store the MSCP unit number MOV (SP)+,P.OPCD(R2) ; Store the opcode from caller CK.R3 MBUFF .Assume CK.R0 EQ W.EMT .Assume W.EMT EQ W.CHAN .Assume W.CHAN+1 EQ W.EMTC .Assume W.EMTC+1 EQ W.SBLK .Assume W.SBLK+2 EQ W.SBUF .Assume W.SBUF+2 EQ W.SWCT .Assume W.SWCT+2 EQ W.SFUN .Assume W.SFUN+2 EQ W.SRTN EMT .SPFUN ; Go do it ; R3 -> Beginning of the MSCP buffer; P.STS = offset to status codes RETURN ...... .DSABL LSB .SBTTL SETUP - Build EMT block for SPFUNs ;+ ; Provide common service to $TABCK and $GSTAT. Set up the EMT ; argument block for an .SPFUN. ; ; Calling Sequence: ; ; ; ; ; ; CALL SETUP ; (RETURN) ; ; ; ; ; ;- SETUP: MOV R3,-(SP) ; Save SPFUN code. CK.R5 W.BASE CK.R3=CK.R5 MOV R5,R3 ; Copy work area addr CK.R3 ,+2+2 CMP (R3)+,(R3)+ ; Point to EMT area CK.R3 W.EMT MOV R3,R0 ; Setup R0 for EMT CK.R0=CK.R3 CK.R3 W.CHAN,+1 TSTB (R3)+ ; Skip channel CK.R3 W.EMTC,+1 MOVB #SPFUN.,(R3)+ ; Set the SPFUN code and ... CK.R3 W.SBLK,+2 CLR (R3)+ ; Clear block CK.R3 W.SBUF,+2 TST (R3)+ ; Skip BUFF for now... CK.R3 W.SWCT,+2 MOV R2,(R3)+ ; set WCNT arg CK.R3 W.SFUN,+2 MOV (SP)+,(R3)+ ; Store passed SPFUN code, CK.R3 W.SRTN,+2 CLR (R3)+ ; Clear completion routine CK.R3 ,+> ADD #>,R3 ; point to available area CK.R0 W.EMT MOV R3,W.SBUF-W.EMT(R0) ; Store buffer addr in EMT block CK.R3 ,,SBUFF CK.R3 ,,MBUFF RETURN ...... .SBTTL DECIMA - Convert binary to 2-digit ASCII ;+ ; DECIMA - Converts a 7-bit binary to 2-digit ASCII ; ; On entry, R0 contains value to convert. ; On return, R1 contains the low digit, and R2 contains the high digit. ;- .ENABL LSB DECIMA: MOV R0,R2 ; R1 will hold low digit. CLR R1 ; R2 will hold high digit. 10$: INC R1 ; One more unit of 10. in high digit. SUB #10.,R2 ; Subtract it from low digit. BHIS 10$ ; Keep going till all units of 10. ; are gone from low digit. DEC R1 ; We did one unit of 10 too many ; so subtract if from high digit, ADD #10.+'0,R2 ; add it to low digit, & make ascii CMP R1,#10. ; R2 > 10? BLT 20$ ; Yes, we have two digit number.. CLR R1 ; No, this is error, make it 0. 20$: ADD #'0,R1 ; make high digit ascii, too RETURN ...... .DSABL LSB .SBTTL RSHERR - Restore SERR or HERR status ;+ ; RSHERR - Restore the previous value of I.SERR in user's ; Impure Area. For current value = 1 (.SERR last ; requested). ; ENTRY: R5 -> Work Area ;- .ENABL LSB RSHERR: TSTB W.SHER(R5) ; Get previous I.SERR value BNE 10$ ; if it was .SERR then skip this .HERR ; ask for hard errors 10$: RETURN ...... .DSABL LSB .END