.TITLE ERTXT - Get Error Message From QIOSYM .IDENT /V01.00/ .ENABL LC ;+ ; This routine gets a message from QIOSYM and returns a pointer to it ; to the caller. The routine uses Files-11 QIO's to avoid FCS/RMS over- ; head. QIOSYM.MSG is a file with 64. character fixed length records. the ; caller supplies the record number he desires (starting with 1). ; ; Call with: JSR PC,ERTEXT ; R2 = Message number in QIOSYM. ; ; Exit with: R2 = Message address or 0 if not found. ;- .MCALL NMBLK$,ALUN$S,QIOW$,DIR$ .PSECT ERR$RW,RW,D QIONMB: NMBLK$ QIOSYM,MSG,,LB,0 ;File name block DIRNMB: NMBLK$ 001002,DIR,,LB,0 ;Directory name block . = DIRNMB+N.DID .WORD -1,-1 ;Set directory access . = DIRNMB+S.FNB GETDIR: QIOW$ IO.FNA,,24.,,IOSTAT,,<0,0,0,0,0,DIRNMB> GETFIL: QIOW$ IO.FNA,,24.,,IOSTAT,,<0,0,0,0,0,QIONMB> ACCESS: QIOW$ IO.ACR,,24.,,IOSTAT,, READBK: QIOW$ IO.RVB,,24.,,IOSTAT,, DEAESS: QIOW$ IO.DAC,,24.,,IOSTAT,, BUFFER: .BLKB 512. ;Disk block input buffer IOSTAT: .BLKW 2 ;I/O status buffer .PSECT ERR$CD,RO,I ERTXT:: MOV R2,-(SP) ;Save the record number TST QIONMB+N.FID ;Have we been here before? BNE 2000$ ; if NE - yes, skip setup MOV ERLUN2,R0 ;Get lun to use ALUN$S R0,#"LB,#0 ;Assign to LB0: BCS 9998$ ; if CS - assignment error MOV #GETDIR,R1 ;Get the first QIO MOV #5,R2 ;We know there are 5 QIO's 1000$: MOV R0,Q.IOLU(R1) ;Store lun number ADD #Q.IOPL+12.,R1 ;Advance to the next QIO DEC R2 ;Count till we are done BNE 1000$ ; if ne - not done CALL QIOW ;Lookup directory file .WORD GETDIR ; BCS 9998$ ; if CS - error MOV #DIRNMB,R1 ;Get address of directory nameblock MOV #QIONMB+N.DID,R0;Get address of file name block directory id MOV (R1)+,(R0)+ ;Move directory id MOV (R1)+,(R0)+ ; MOV (R1)+,(R0)+ ; CALL QIOW ;Lookup file .WORD GETFIL ; BCS 9998$ ; if CS - error 2000$: CALL QIOW ;Access file .WORD ACCESS ; BCS 9998$ ; if CS - error DEC (SP) ;Correct record number to 0 base MOV (SP),R2 ;Save record number ASR R2 ;Get block number to read ASR R2 ; ASR R2 ; INC R2 ;Vbn start at 1 MOV R2,READBK+Q.IOPL+8. ;Store in dpb CALL QIOW ;Read block .WORD READBK ; ROR R0 ;Save carry for later check CALL QIOW ;Deaccess file .WORD DEAESS ; BCS 9998$ ; if CS - error ROL R0 ;Unsave carry from read BCS 9998$ ; if CS - error MOV (SP),R2 ;Get the record number again BIC #177770,R2 ;Get record inside block SWAB R2 ;This way there are less shifts ASR R2 ; ASR R2 ; ADD #BUFFER,R2 ;Make into real pointer TSTB (R2) ;If first byte is null, no message BNE 9999$ ; if NE - good message 9998$: CLR R2 ;Set to no message 9999$: TST (SP)+ ;Clean stack RETURN ;Return to caller ;+ ; This routine issues QIO'S for ERTXT and checks for errors on return. ;- QIOW: MOV @(SP),R0 ;Get DPB address ADD #2,(SP) ;Return to caller+2 DIR$ R0 ;Issue QIO BCS 9999$ ; if cs - exit TSTB IOSTAT ;Where we a success? BGT 9999$ ; if GT - yes SEC ;Set error flag 9999$: RETURN ;Return to caller .END