.TITLE DIRHDR - Display File Header .IDENT /1.2/ .ENABL LC ;+ ; ; Free software BY ; Project Software & Development, Inc. ; ; This software is furnished for free and may be used and copied as ; desired. This software or any other copies thereof may be provided or ; otherwise made available to any other person. No title to and ; ownership of the software is hereby transferred or allowed. ; ; The information in this software is subject to change without notice ; and should not be construed as a commitment by PROJECT SOFTWARE ; AND DEVELOPMENT, INC. ; ; PROJECT SOFTWARE assumes no responsibility for the use or reliability ; of this software on any equipment whatsoever. ; ; Project Software & Development, Inc. ; 14 Story St. ; Cambridge, Ma. 02138 ; 617-661-1444 ; ; ; Title: DIRHDR.MAC ; Author: Robin Miller ; Date: February 19, 1985 ; ; Description: ; ; This module contains the routines to display the file header. ; ; Modification History: ; ; April 25, 1985 by Robin Miller. Edit (02), Version 1.2 ; Use the selected file count instead of the directory file count ; to determine if this is the first file of this directory. ; ; April 10, 1985 by Robin Miller. Edit (01), Version 1.1 ; Read the entire file header to get desired information for ; ANSI magtapes. The read dates and times ACP function (-15,43) ; returns "Privilege Violation" for ANSI magtapes. ; ;- .ENABL AMA .NLIST BEX .MCALL DIR$, QIOW$ .MCALL FCSBT$, FDOFF$, FHDOF$, NBOFF$ FCSBT$ ; Define the FCS bits. FDOFF$ DEF$L ; Define the FDB offsets. FHDOF$ DEF$L ; Define the file header offsets. NBOFF$ DEF$L ; Define the FNB offsets. ; ACP function codes to read the file attributes: RFHBLK: .BYTE -12,0 ; Read the entire file header, (01) .WORD HDRBUF ; and store it here. (01) .BYTE -11,12 ; Read the statistics block .WORD HDRBUF+V.STBK ; and store them here. .WORD 0 ; End of ACP QIO list. ; Directive parameter block to read the file attributes. RFHDR: QIOW$ IO.RAT,,,,DSKSB,,<,RFHBLK,,,,> DSKSB:: .BLKW 2 ; Disk I/O status block. ; Define the header record offsets: ; Size Description: V.UIC == H.FOWN ; ( 2) The binary file owner UIC. V.PROT == H.FPRO ; ( 2) The binary protection code. V.FCHA == H.UCHA ; ( 2) The file characteristics. V.UCHA == V.FCHA ; ( 1) The user file characteristics. V.SCHA == V.UCHA+1 ; ( 1) The system file characteristics. V.UFAT == H.UFAT ; (32) The user file attributes. ; FCS uses the 1st 14 bytes. V.RTYP == V.UFAT ; ( 1) The record type. V.FORG == V.RTYP ; RMS format and organization. V.RATT == V.RTYP+1 ; ( 1) The record attributes. ; Same offset for RMS. V.RSIZ == V.RATT+1 ; ( 2) The maximum record size. ; Same offset for RMS. V.HIBK == V.RSIZ+2 ; ( 4) The highest block number. V.HVBN == V.HIBK ; RMS high virtual block number. V.EFBK == V.HIBK+4 ; ( 4) The end of file block number. V.HEOF == V.EFBK ; RMS end of file block number. V.FFBY == V.EFBK+4 ; ( 2) The 1st free byte in last block. ; Same offset for RMS. ; Start of RMS specific offsets: V.BKSZ == V.FFBY+2 ; ( 1) Bucket size (relative/indexed). V.HDSZ == V.BKSZ+1 ; ( 1) The fixed header size. V.MRS == V.HDSZ+1 ; ( 2) The maximum record size limit. V.DEQ == V.MRS+2 ; ( 2) The default extend quantity. ; Start of identification area: V.FNAM == I.FNAM ; ( 6) The file name (Radix-50). V.FTYP == I.FTYP ; ( 2) The file type (Radix-50). V.FVER == I.FVER ; ( 2) The file version (binary). V.REVN == I.RVNO ; ( 2) The revision number (binary). V.RDAT == I.RVDT ; ( 7) The revision date (ddmmmyy). V.RTIM == I.RVTI ; ( 6) The revision time (hhmmss). V.CDAT == I.CRDT ; ( 7) The creation date (ddmmmyy). V.CTIM == I.CRTI ; ( 6) The creation time (hhmmss). V.EDAT == I.EXDT ; ( 7) The expiration date (ddmmmyy). ; Start of ANSI magtape offsets: V.HDR1 == 46. ; (80) The file header label (HDR1). V.HNAM == V.HDR1+4 ; (17) The ANSI file name (ASCII). V.HDR2 == 126. ; (80) The file header label (HDR2). V.HBSZ == V.HDR2+5 ; ( 5) The block length (ASCII). V.HRSZ == V.HDR2+10. ; ( 5) The record length (ASCII). V.STBK == H.CKSM+2 ; Start of the statistics block. V.HLBN == V.STBK ; ( 2) High logical block number. V.LLBN == V.HLBN+2 ; ( 2) Low logical block number. V.SIZE == V.LLBN+2 ; ( 4) The file size high/low. V.ACNT == V.SIZE+4 ; ( 1) The access count. V.LCNT == V.ACNT+1 ; ( 1) The lock count. HDRSIZ = <512.+10.> ; Size in bytes of the header buffer. HDRBUF::.BLKB HDRSIZ ; Buffer for file header information. .EVEN ; File organizations: ORGTBL: .WORD SEQM ; (0) Sequential. .WORD RELM ; (1) Relative. .WORD IDXM ; (2) Indexed. .WORD HSHM ; (3) Hashed. MAXORG = <<.-ORGTBL>/2> ; Maximum file organization. SEQM: .ASCIZ "Sequential" RELM: .ASCIZ "Relative" IDXM: .ASCIZ "Indexed" HSHM: .ASCIZ "Hashed" .EVEN ; Record format table: RTYPE: .WORD UNDM ; (0) Undefined record format. .WORD FIXM ; (1) Fixed length records. .WORD VARM ; (2) Variable length records. .WORD VFCM ; (3) Variable with fixed control. .WORD STMM ; (4) ASCII Stream records. .WORD STLM ; (5) Stream line-feed records. .WORD STRM ; (6) Stream carriage-return records. MAXTYP = <<.-RTYPE>/2> ; Maximum record type. UNDM: .ASCIZ "Undefined" FIXM: .ASCIZ "Fixed" VARM: .ASCIZ "Variable" VFCM: .ASCIZ "Variable-with-fixed-control" STMM: .ASCIZ "Stream" STLM: .ASCIZ "Stream_LF" STRM: .ASCIZ "Stream_CR" .EVEN ; Record attributes messages. RATBL: .WORD NOM ; (0) No record attributes. .WORD FTNM ; (1) Fortran carriage control. .WORD CRM ; (2) Implied carriage control. .WORD UNKM ; (3) Unknown record attributes. .WORD PRNM ; (4) Print carriage control. MAXRAT = <<.-RATBL>/2> ; Maximum record attribute. NOM: .ASCIZ "No" UNKM: .ASCIZ "Unknown" FTNM: .ASCIZ "Fortran" CRM: .ASCIZ "Carriage return" PRNM: .ASCIZ "Print file" BLKM: .ASCIZ "No-span" .EVEN .SBTTL RDHDR - Read the file header. ;+ ; ; RDHDR - Read the file header information. ; ; Inputs: ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = success/failure. ; ; All registers are preserved. ; ;- RDHDR:: CALL $SAVAL ; Save all registers. ; Setup the LUN, EFN, and FNB for the QIO. MOV #RFHDR,R2 ; Set the QIO DPB address. MOV O.FDB(R5),R3 ; Copy the FDB address. MOVB F.LUN(R3),Q.IOLU(R2) ; Setup the logical unit number. MOVB F.EFN(R3),Q.IOEF(R2) ; Setup the event flag number. MOV O.FNB(R5),Q.IOPL(R2) ; Setup the FNB address. ; Issue the QIO to read the file header information. BIS #B.FERR,STATUS ; Display file name on errors. MOV R5,EENTRY ; Setup file address for errors. DIR$ #RFHDR ; Read the file header information. CALL CHKDSK ; Check for directive or I/O errors. BIC #B.FERR,STATUS ; Reset the file error flag. BCS 100$ ; If CS, we had an error. MOV #HDRBUF,R2 ; Set the file header address. ; Calculate and save the identification offset. MOVB H.IDOF(R2),R1 ; Copy identification offset. (01) ASL R1 ; Convert it to a byte offset. (01) MOV R1,IOFSET ; Save identification offset. (01) ; Copy the file size from the statistics block for open files. MOV V.SIZE(R2),V.HIBK(R2) ; Copy the high block size, MOV V.SIZE+2(R2),V.HIBK+2(R2) ; and the low block size. ; Set the end of file block count for magtapes. BITB #CH.AND,F.CHR(R3) ; Is this an ANSI magtape ? (01) BEQ 10$ ; If EQ, no (continue ...). (01) MOV V.SIZE(R2),V.EFBK(R2) ; Yes, set end of file block (01) MOV V.SIZE+2(R2),V.EFBK+2(R2) ; to allocated block size.(01) BR 30$ ; And continue ... (01) ; Adjust for empty (zero) end of file block. 10$: TST V.FFBY(R2) ; First free byte in block zero ? BNE 30$ ; If NE, yes. TST V.EFBK+2(R2) ; Is the low block non-zero ? (01) BNE 20$ ; If NE, yes. (01) TST V.EFBK(R2) ; Is the high block non-zero ? (01) BEQ 30$ ; If EQ, no (don't adjust). (01) 20$: SUB #1,V.EFBK+2(R2) ; Yes, blocks used is one less. SBC V.EFBK(R2) ; Adjust for the carry (if any). MOV #512.,V.FFBY(R2) ; First free byte is in next block. 30$: TSTB DATESW+1 ; Selecting files by date ? BEQ 100$ ; If EQ, no. CALL SETDAT ; Yes, setup the file date/time. 100$: RETURN .SBTTL DOFULL - Display full directory. ;+ ; ; DOFULL - Display full directory format. ; ; Inputs: ; R0 = The output buffer address. ; R5 = The file entry address. ; ; Outputs: ; R0 = The starting buffer address. ; ; C bit clear/set = success/failure. ; ; All other registers are preserved. ; ;- .ENABL LSB DOFULL::JSR R5,.SAVR1 ; Save R1 - R5. MOV #HDRBUF,R2 ; Set the header buffer address. CMP SELCNT,#1 ; First file of this directory? (02) BEQ 10$ ; If EQ, yes. CRLF ; Format the file name. 10$: MVS ,30. MOV O.FNAM(R5),R1 ; Copy the file name buffer address. CALL MOVE ; And copy it. PAD ; Format the file identication (FID). MVS ,10. PAD CALL DOFID ; Do the file ID. CRLF ; Format the file size: MVS ,30. MOV R2,R1 ; Copy the header record address. ADD #V.EFBK,R1 ; Point to the end of file block. CALL CVTDBL ; Convert double decimal number. ; Format the number of blocks allocated. MVS ; Separate used from allocated. MOV R2,R1 ; Copy the header record address. ADD #V.HIBK,R1 ; Point to the high block number. CALL CVTDTD ; Convert double decimal number. PAD ; Format the file owner UIC. MVS ,10. PAD CALL DOUIC ; Format the file owner UIC. CRLF ; Format the creation date and time. MVS ,30. CALL DOCDAT ; Do the creation date. PAD ; Format the revision date, time, and revision number. MVS ,10. PAD CALL DORDAT ; Do the revision date. MVS < (> MOV R2,R1 ; Copy header buffer address. (01) ADD IOFSET,R1 ; Point to identification area. (01) MOV V.REVN(R1),R1 ; Copy the revision number. (01) CALL CVTDEC ; Convert it to decimal ASCII. MVS <)> CRLF ; Format the expiration date. MVS < >,30. PAD MVS ,10. PAD CALL DOEDAT ; Do the expiration date. CRLF ; Format the file organization (bits 4-7 of V.RTYP). MVS ,20. PAD MOVB V.FORG(R2),R1 ; Copy the file organization byte. ASH #-4,R1 ; Shift into bits 0-4. BIC #^C17,R1 ; Clear unwanted bits. CALL DOORG ; Do the file organization. CRLF ; Format the file attributes: MVS ,20. PAD MVS MOV R2,R1 ; Copy the header record address. ADD #V.HIBK,R1 ; Point to the high block number. CALL CVTDTD ; Convert double decimal number. MVS <, Extend: > MOV V.DEQ(R2),R1 ; Copy the extend value. CALL CVTDEC ; Convert it to decimal ASCII. ; Format and output the bucket size (if there is one). TSTB V.BKSZ(R2) ; Is there a bucket size ? BEQ 30$ ; If EQ, no (skip this then). MVS <, maximum bucket size = > MOVB V.BKSZ(R2),R1 ; Copy the bucket size. CALL CVTDEC ; Convert it to decimal ASCII. 30$: CRLF ; Format the user/system characteristics. CALL DOCHA ; Format the user/system char. ; Format the magtape block length. CALL DOANSI ; Format the ANSI block length. (01) ; Format the record format (bits 0-3 of V.RTYP). MVS ,20. PAD MOVB V.RTYP(R2),R1 ; Copy the binary file type. BIC #^C17,R1 ; Clear unwanted bits. CALL DORTYP ; Do the record format message. ; Format and output the fixed control size (if there is one). TSTB V.HDSZ(R2) ; Is there a fixed control size ? BEQ 40$ ; If EQ, no (skip it). MVS <, > MOVB V.HDSZ(R2),R1 ; Copy the fixed control size. CALL CVTDEC ; Convert it to decimal ASCII. MVS < byte header> ; Put longest record size on the next line. CRLF MVS < >,20. PAD MVS BR 50$ ; Use common code ... ; Format the longest record size. 40$: MVS <, longest record is > 50$: MOV V.RSIZ(R2),R1 ; Copy the longest record size. CALL CVTDEC ; Convert it to decimal ASCII. MVS < bytes> CRLF ; Format the maximum record size. TST V.MRS(R2) ; Is there a maximum record size ? BEQ 60$ ; If EQ, no (not an RMS file). MVS < >,20. PAD MVS MOV V.MRS(R2),R1 ; Copy the maximum record size. CALL CVTDEC ; Convert it to decimal ASCII. MVS < bytes> CRLF ; Format the record attributes. 60$: MVS ,20. PAD MOVB V.RATT(R2),R1 ; Copy the record attributes. BIC #^C17,R1 ; Clear unwanted bits. CALL DORAT ; Do the record attributes. MVS < carriage control> CRLF ; Format the protection. MVS ,20. PAD CALL ADDPRO ; Add the protection fields. CRLF JMP VTYPE ; Write the message and return. .DSABL LSB .SBTTL DOANSI - Format the ANSI block length. ;+ ; ; DOANSI - Format the ANSI block length. ; ; This routine is used to format the ANSI block length for magtapes. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The file header address. ; R5 = The file entry address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- .ENABL LSB DOANSI::JSR R5,.SAVR1 ; Save R1 - R5. Added for edit (01) ; For ANSI magtape, format the block length. MOV O.FDB(R5),R4 ; Copy the FDB address. BITB #CH.AND,F.CHR(R4) ; Is this an ANSI magtape ? BEQ 100$ ; If EQ, no (skip this). MVS ,20. PAD MOV R2,R1 ; Copy header buffer address. ADD IOFSET,R1 ; Point to identification area. ADD #V.HBSZ,R1 ; Point to the ASCII block size. MOV #5,R2 ; Set the block length count. ; Skip leading zeros in the ASCII string. 10$: CMPB (R1)+,#'0 ; Is this a leading zero ? BNE 20$ ; If NE, no (copy number). SOB R2,10$ ; Check the next character. BR 100$ ; We shouldn't get here. 20$: DEC R1 ; Point to character to copy. 30$: MOVB (R1)+,(R0)+ ; Copy the ASCII block length. SOB R2,30$ ; Loop until we're done. MVS < bytes> CRLF 100$: RETURN .DSABL LSB .SBTTL DOCHA - Format the user/system characteristics. ;+ ; ; DOCHA - Format the user/system characteristics. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The file header address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- .ENABL LSB DOCHA:: JSR R5,.SAVR1 ; Save R1 - R5. ; Check for any file characteristics. TST V.FCHA(R2) ; Any file characteristics ? BEQ 200$ ; If EQ, no ; ; Format the user attributes (if any). ; ; User characteristic bits: Value ; ; UC.CNB Contiguous-best-try. ( 40) ; UC.CON Contiguous. (200) ; UC.DLK Deaccess-locked. (100) ; UC.NIB ??? ( 2) ; UC.RCK ??? ( 10) ; UC.WBC ??? ( 4) ; UC.WCK Write-check ( 20) ; MVS ,20. PAD ; Format the contiguity options. BITB #UC.CON,V.UCHA(R2) ; Is the file contiguous ? BEQ 10$ ; If EQ, no. MVS BITB #UC.CNB,V.UCHA(R2) ; Is this contiguous-best-try ? BEQ 10$ ; If EQ, no. SUB #2,R0 ; Backup over previous ", ". MVS <-best-try, > ; Format the deaccess-locked state. 10$: BITB #UC.DLK,V.UCHA(R2) ; Is the file deaccess-locked ? BEQ 20$ ; If EQ, no. MVS ; Format the write-check state. 20$: BITB #UC.WCK,V.UCHA(R2) ; File set for write-check ? BEQ 100$ ; If EQ, no. MVS ; ; Format the system characteristics (if any). ; ; System characteristic bits: Value ; ; SC.BAD Bad data block in file. (100) ; SC.DIR Directory ??? ( 40) ; SC.MDL Marked for delete. (200) ; SC.SPL ??? ( 20) ; ; Format the bad data block state. 100$: BITB #SC.BAD,V.SCHA(R2) ; Bad data block in file ? BEQ 110$ ; If EQ, NO MVS ; Format the marked for delete state. 110$: BITB #SC.MDL,V.SCHA(R2) ; Is file marked for delete ? BEQ 120$ ; If EQ, no. MVS 120$: SUB #2,R0 ; Backup over the final ", ". CRLF ; Add EOL carriage control. 200$: RETURN .DSABL LSB .SBTTL DOUIC - Format the file owner UIC. ;+ ; ; DOUIC - Format the file owner UIC. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The file header address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- DOUIC:: JSR R5,.SAVR1 ; Save R1 - R5. MOV V.UIC(R2),R3 ; Copy the binary owner UIC. MOV R0,R2 ; Copy the output buffer address. MOV #1,R4 ; Setup the control code. CALL .PPASC ; Convert the UIC to [ggg,mmm]. MOV R2,R0 ; Copy the output buffer address. RETURN .SBTTL ADDPRO - Add The Protection Message ;+ ; ; ADDPRO - Add the file protection message. ; ; Inputs: ; R0 = the output buffer address. ; R2 = address of the header record. ; ; Outputs: ; R0 = the updated buffer address. ; ; All other registers are preserved. ; ;- ADDPRO::JSR R5,.SAVR1 ; Save R1 - R5 MOV V.PROT(R2),R3 ; Copy the protection code. ; Setup the system protection. MVS CALL SETPRO ; Move in the protection. ; Setup the owner protection. MVS <, Owner: > ASH #-4,R3 ; Shift bits into place. CALL SETPRO ; Move in the protection. ; Setup the group protection. MVS <, Group: > ASH #-4,R3 ; Shift bits into place. CALL SETPRO ; Move in the protection. ; Setup the world protection. MVS <, World: > ASH #-4,R3 ; Shift bits into place. ;*** CALL SETPRO ; Move in the protection. ;*** RETURN ; Move in the protection codes: RWED SETPRO::BIT #FP.RDV,R3 ; Allowed read access ? BNE 10$ ; If NE, no. MOVB #'R,(R0)+ ; Yes, show it. 10$: BIT #FP.WRV,R3 ; Allowed write access ? BNE 20$ ; If NE, no. MOVB #'W,(R0)+ ; Yes, show it. 20$: BIT #FP.EXT,R3 ; Allowed execute access ? BNE 30$ ; If NE, no. MOVB #'E,(R0)+ ; Yes, show it. 30$: BIT #FP.DEL,R3 ; Allowed delete access ? BNE 40$ ; If NE, no. MOVB #'D,(R0)+ ; Yes, show it. 40$: CLRB (R0) ; Terminate output buffer. RETURN .SBTTL DORAT - Do The Record Attributes. ;+ ; ; DORAT - Do the record attributes. ; ; Inputs: ; R0 = the output buffer address. ; R1 = the binary record attributes byte. ; ; Outputs: ; R0 = the updated buffer address. ; ; All other registers are preserved. ; ;- DORAT:: JSR R5,.SAVR1 ; Save R1 - R5 CMP R1,#MAXRAT ; Is the attribute too large ? BLO 10$ ; If LO, no (it's in range). MOV R1,R2 ; Copy the record attributes. MOV #BLKM,R1 ; Presume no-span attribute. BITB #FD.BLK,R2 ; Is it no-span attribute ? BNE 20$ ; If NE, yes. MOV #UNKM,R1 ; Nope, tellem "unknown" BR 20$ ; And continue ... 10$: ASL R1 ; Make a word offset. MOV RATBL(R1),R1 ; Get the message address. 20$: CALL MOVEC ; And copy it. RETURN .SBTTL DOORG - Do The File Organization ;+ ; ; DOORG - Do the file organization. ; ; Inputs: ; R0 = the output buffer address. ; R1 = the binary organization value. ; ; Outputs: ; R0 = the updated buffer address. ; ; All other registers are preserved. ; ;- DOORG:: JSR R5,.SAVR1 ; Save R1 - R5 CMP R1,#MAXORG ; Is it too large ? BLO 10$ ; If LO, no. MOV #UNDM,R1 ; Tellem "undefined". BR 20$ ; And copy it. 10$: ASL R1 ; Make a word offset. MOV ORGTBL(R1),R1 ; Get the message address. 20$: CALL MOVEC ; And copy it. RETURN .SBTTL DORTYP - Do The Record Type Message ;+ ; ; DORTYP - Do the record type message. ; ; Inputs: ; R0 = the output buffer address. ; R1 = the binary record type. ; ; Outputs: ; R0 = the updated buffer address. ; ; All other registers are preserved. ; ;- DORTYP::JSR R5,.SAVR1 ; Save R1 - R5 CMP R1,#MAXTYP ; Is the type too large ? BLO 10$ ; If LO, no. CLR R1 ; Yes, force "undefined". 10$: ASL R1 ; Make a word offset. MOV RTYPE(R1),R1 ; Get the message address. CALL MOVEC ; And copy it. RETURN .SBTTL DOCDAT - Do the creation date. ;+ ; ; DOCDAT - Do the creation date. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The header buffer address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- DOCDAT::JSR R5,.SAVR1 ; Save R1 - R5 MOV R2,R1 ; Copy the header buffer address. ADD IOFSET,R1 ; Point to identification area. (01) ADD #V.CDAT,R1 ; Point to the creation date. CALL MAKDAT ; Format the creation date. MOV R2,R1 ; Copy the header buffer address. ADD IOFSET,R1 ; Point to identification area. (01) ADD #V.CTIM,R1 ; Point to the creation time. CALL MAKTIM ; Format the creation time. RETURN .SBTTL DORDAT - Do the revision date. ;+ ; ; DORDAT - Do the revision date. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The header buffer address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- DORDAT::JSR R5,.SAVR1 ; Save R1 - R5 MOV R2,R1 ; Copy the header buffer address. ADD IOFSET,R1 ; Point to identification area. (01) ADD #V.RDAT,R1 ; Point to the revision date. CALL MAKDAT ; Format the revision date. MOV R2,R1 ; Copy the header buffer address. ADD IOFSET,R1 ; Point to identification area. (01) ADD #V.RTIM,R1 ; Point to the revision time. CALL MAKTIM ; Format the revision time. RETURN .SBTTL DOEDAT - Do the expiration date. ;+ ; ; DOEDAT - Do the expiration date. ; ; Inputs: ; R0 = The output buffer address. ; R2 = The header buffer address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- .ENABL LSB DOEDAT::JSR R5,.SAVR1 ; Save R1 - R5 MOV R2,R1 ; Copy the header buffer address. ADD IOFSET,R1 ; Point to identification area. (01) ADD #V.EDAT,R1 ; Point to the expiration date. CMPB 5(R1),#'5 ; Date = 17NOV58 for VAX/VMS ? BEQ 5$ ; If EQ, yes (No expiration date). TSTB (R1) ; Is there an expiration date ? BNE 10$ ; If NE, yes. 5$: MOVB #'<,(R0)+ ; Put in left angle bracket. MVS MOVB #'>,(R0)+ ; End with a right angle bracket. CLRB (R0) ; Terminate the output buffer. BR 20$ ; And use common return ... 10$: CALL MAKDAT ; Format the expiration date. 20$: RETURN .DSABL LSB .SBTTL DOFID - Do the file identification. ;+ ; ; DOFID - Do the file identification. ; ; Inputs: ; R0 = The output buffer address. ; R5 = The file entry address. ; ; Outputs: ; R0 = The updated buffer address. ; ; All other registers are preserved. ; ;- DOFID:: JSR R5,.SAVR1 ; Save R1 - R5 MOV O.FNB(R5),R4 ; Copy the file name block address. MOVB #'(,(R0)+ ; Start with left parenthesis. MOV (R4)+,R1 ; Copy the first FID word. CALL 10$ ; Convert it to ASCII. MOVB #',,(R0)+ ; Put in the delimiter. MOV (R4)+,R1 ; Copy the second FID word. CALL 10$ ; Convert it to ASCII. MOVB #',,(R0)+ ; Put in the delimiter. MOV (R4)+,R1 ; Copy the third FID word. CALL 10$ ; Convert it to ASCII. MOVB #'),(R0)+ ; End with right parenthesis. CLRB (R0) ; Terminate with a null. RETURN 10$: TST VAXFLG ; Are we running on VAX/VMS ? BEQ 20$ ; If EQ, no (presume RSX-11M). CALL CVTDEC ; Convert it to decimal ASCII. RETURN 20$: CALL CVTOCT ; Convert it to octal ASCII. RETURN .END