.TITLE SRDINI .IDENT -6.3- ; 01-JUN-83 ;+ ; ; **SRD--SORT DIRECTORY ; ; TASK INITIALIZATION PHASE ; ; ; THIS TASK WILL SORT A RSX11M DIRECTORY ; THEN CREATE A LISTING WITH SEVERAL SELECTION OPTIONS ; ;- ; ; MODIFICATIONS: ; ; BT001 - 01-DEC-81 ; CORRECT CHECK FOR /WB TO SEE IF WE SHOULD SORT THE DIRECTORY; ; ADD /ZE SWITCH; ; CHANGE SYMBOL FOR /00 SWITCH VALUE TO ZDSW (FROM ZESW) AND MOVE ; TO SWMS3$; ; TURN OFF /WI AND /WD IF /SE SPECIFIED ; ; RBD001 13-Jul-82 ; Add exit with status support for '11M ; Delete garbage at the end of the file ; ; BT002 - 18-May-83 ; Merged in /SM, /HD, and /BK switches from Glen Everhart's ; Fall 1982 version; ; Do not allow /DE without file name or /SE specified; ; When file name on command line has no ".", append ".*;*" ; only when original search string ended in "*" (e.g., ; /SE:*ABC*); otherwise, append ".;*", to prevent deletion ; of all files with that name and any type (e.g., when ; GHI/DE specified) ; ; CEF001 - 01-June-83 ; CREATE I (RO) AND D (RW) PSECTS ; ; ; ; ; SYSTEM MACRO CALLS ; ;CEF001 .PSECT SRDATA,D,RW,LCL,REL,CON ;CEF001 ; ;CEF001 ; .MCALL CSI$1,CSI$2,DIR$,EXIT$S,GCMLD$,GCML$,FHDOF$,ALUN$S .MCALL GTIM$S,WTSE$S,CSI$SW,CSI$SV,CSI$ND,NMBLK$,CLOSE$ .IF DF R$$11M .MCALL EXRG$S,GPRT$ ; 04 EXTEND REQION .MCALL EXST$S ;RBD001 .IFF .MCALL GTSK$ ; GET TASK PARAMETERS. .ENDC FHDOF$ DEF$L ; DEFINE FILE HEADER ; .IF DF R$$11M GETPAR: GPRT$ ,PARBF$ .IFF GTSK: GTSK$ PARBF$ .ENDC STRING: .ASCII /SY:/ .EVEN SWTABL: CSI$SW NA,NASW,SWMSK$,SET,NEG CSI$SW MI,MISW,SWMSK$,SET,NEG,FUVAL CSI$SW SP,SPSW,SWMSK$,SET,NEG CSI$SW HV,HVSW,SWMS2$,SET,NEG,HVVAL CSI$SW NE,NESW,SWMSK$,SET,NEG CSI$SW BE,,SWMSK$,SET,NEG,BEVAL CSI$SW AF,,SWMSK$,SET,NEG,AFVAL CSI$SW SE,SESW,SWMSK$,SET,,SEVAL CSI$SW SD,,SWMSK$,SET,NEG,SEVAL CSI$SW PU,,SWMSK$,SET,NEG,PUVAL CSI$SW OV,,SWMSK$,SET,NEG,PUVAL CSI$SW WB,WBSW,SWMS2$,SET,NEG CSI$SW SV,SVSW,SWMSK$,SET,NEG,PUVAL CSI$SW LI,LISW,SWMSK$,SET,NEG,FUVAL CSI$SW DE,DESW,SWMSK$,SET,NEG CSI$SW DA,DASW,SWMSK$,SET,NEG,AFVAL CSI$SW FU,FUSW,SWMSK$,SET,NEG,FUVAL CSI$SW CO,COSW,SWMS2$,SET,NEG CSI$SW LO,LOSW,SWMS2$,SET,NEG CSI$SW MU,MUSW,SWMS2$,SET,NEG CSI$SW ID,IDSW,SWMS2$,SET ; +007 /IDENT CSI$SW SI,SISW,SWMS2$,SET ; +007 /SI CSI$SW AE,,SWMSK$,SET,NEG,AFVAL CSI$SW BF,,SWMSK$,SET,NEG,BEVAL CSI$SW RD,RDSW,SWMS2$,SET,NEG CSI$SW SR,SRSW,SWMS2$,SET,NEG CSI$SW SY,SYSW,SWMS2$,SET,NEG CSI$SW AT,ATSW,SWMS2$,SET,NEG CSI$SW WI,WISW,SWMS2$,SET,NEG CSI$SW WD,,SWMS2$,SET,NEG CSI$SW 00,ZDSW,SWMS3$,SET,NEG ;BT001 CSI$SW HE,HESW,SWMS2$,SET,NEG ;**-1 CSI$SW M2,M2SW,SWMS2$,SET,NEG CSI$SW ZE,ZESW,SWMS2$,SET,NEG ;BT001 CSI$SW BK,BKSW,SWMS3$,SET,NEG ;BT002 CSI$SW SM,SMSW,SWMS3$,SET,NEG ;BT002 CSI$SW HD,HDSW,SWMS3$,SET,NEG ;BT002 CSI$ND CSI$SV ASCII,SEBUF$,16.,SEVAL CSI$SV DECIMAL,LINSZ$,2,FUVAL CSI$SV DECIMAL,VRSCT$,2,PUVAL CSI$SV ASCII,AFBUF$,15.,AFVAL CSI$SV ASCII,BEBUF$,15.,BEVAL CSI$SV OCTAL,LVNUM$,2,HVVAL CSI$ND DFNB: NMBLK$ 200200,DIR,1,SY,0 ; ;CEF001 .PAGE ;CEF001 .SBTTL SRDINI - CODE ;CEF001 .PSECT SRDCOD,I,RO,REL,CON,LCL ;CEF001 SRDINI:: .IF DF R$$11M ; 4.1 IF RUNNING ON RSX11M... DIR$ #GETPAR ; FIND SIZE OF PARTITION MOV PARBF$+2,R0 ; PICK UP SIZE OF PAR/100(OCTAL) SWAB R0 ; THIS ROUTINE ASRB R0 ; CONVERTS THAT SIZE ROR R0 ; INTO SIZE OF PARTITION ROR R0 ; IN BYTES ADD $DSW,R0 ; ADD IN BASE OF PARTITION MOV R0,DIRBE$ ; SAVE END OF DIRECTORY BUFFER .IF DF D$$CAL ; IF DYNAMIC CHECKPOINT ALGORITHM AVAILABLE... SUB LIMBF$,R0 ; FIND SIZE OF REAL WORK BUFFER MOV R0,R1 ; COPY THAT CLC ; 04 ROR R1 ; UN-SIGNED DIVIDE BY 2 ASR R1 ; 04 ASR R1 ASR R1 ASR R1 ASR R1 ; BY 64. NEG R1 ; BLOCK COUNT NEGATIVE EXRG$S R1 ; TRY TO SHRINK TASK BCS LOOP ; BR IF DIDN'T WORK BIC #77,R0 ; MODULO 64 BYTES SUB R0,DIRBE$ ; REDUCE SIZE OF BUFFER .ENDC .IFF ; IF ON RSX11D OR IAS... DIR$ #GTSK ; GET OUR TASK PARAMETERS. MOV PARBF$+G.TSTS,R0 ; GET END OF BUFFER. MOV R0,DIRBE$ ; SET END OF BUFFER. .ENDC LOOP: MOV #SWINI,SWMSK$ ; Initialize masks from TKN Global Definitions MOV #SW2INI,SWMS2$ ; MOV #SW3INI,SWMS3$ ;BT001 MOV #STACLR,R1 ; GET START ADDRESS TO CLEAR MOV #LENCLR,R2 ; AND LENGTH ; 3$: CLRB (R1)+ ; CLEAR A BYTE SOB R2,3$ ; AND SO ON CLR NXUIC$ ; ASSUME NO WILD CARD UICS CLR FLAGS$ ; AND FLAGS CLR LINSZ$ ; ZERO LINE SIZE SW VALUE CLR NXUIC$ ; ASSUME NO WILD CARD UIC'S CLR AFBUF$ ; ZERO RESIDUAL DATE CLR BEBUF$ ; ZERO /BE DATE CLRB SEBUF$ ; CLEAR /SE, /SD BUFFER CLR VRSCT$ ; RESET ANY PURGE COUNT GCML$ #CMDBLK ; GET COMMAND LINE BCC CMDOK ; BR=AOK CMPB CMDBLK+G.ERR,#GE.IOR ; I/O ERROR? BEQ 1$ ; YES CMPB #GE.EOF,G.ERR(R0) ; LOOK FOR END-OF-FILE BEQ 5$ ; BR IF EXPECTED ERROR FERR GCME ; ELSE LOG ERR 1$: DIAG GCME ; ISSUE DIAGNOSTIC 5$: JSR R0,ATTDET ; TRY TO DETACH DEVICE. .WORD IO.DET ; .IF DF R$$11M ;RBD001 EXST$S X$STAT ; TRY TO EXIT WITH STATUS ;RBD001 .ENDC ;RBD001 EXIT$S ; EXIT ;RBD001 ; ;**-1 ; COMMAND ERROR ; CS1ERR: FERR CS1E CS2IER: FERR CS2I CS2OER: FERR CS2O CMDERR: FERR GCME PARSER: FERR PRSE ; ; CMDOK: MOV G.CMLD+2(R0),R1 ; COMMAND START MOV G.CMLD(R0),R2 ; AND LENGTH BNE 20$ ; BR IF COMMAND THERE MOV #STRING,R1 ; SET DEFAULT COMMAND MOV #3,R2 ; LENGTH 20$: CALL SRDREP ; REPLACE SYMBOLS CSI WILL OBJECT TO CSI$1 #CSIBLK,R1,R2 ; CK SYNTAX BCS CS1ERR ; BR IF BAD MOV #SWTABL,C.SWAD(R0) ; SET SWITCH TABLE ADDRESS MOVB #CS.OUT,(R0) ; ASSUME THAT OUTPUT IS ALL THAT WAS GIVEN MOV #LSTDFN,R3 ; GET DEFAULT NAME BLOCK FOR LISTING CLR R2 ; ASSUME NO NAME FOR OUTPUT IN STRING .IF NDF I$$AS ; IF NOT ON IAS... MOV #"TI,N.DVNM(R3) ; ASSUME THAT THE "TI:" IS WHERE IT GOES .IFF ; BUT IF ON IAS... MOV #"TO,N.DVNM(R3) ; ASSUME THAT THE "TO:" IS WHERE IT GOES .ENDC BIT #CS.EQU*400,(R0) ; WAS AN "=" GIVEN? BEQ 30$ ; BR IF NO-ASSUMPTIONS WERE CORRECT MOV #"SY,N.DVNM(R3) ; NAME GIVEN-CHANGE DEFAULT TO "SY0:" CALL .CSI2 ; PARSE REAL OUTPUT NAME BCS CS2OER ; OUTPUT SPEC ERROR MOVB #CS.INP,(R0) ; SET UP TO DO INPUT NEXT MOV #,R2 ; GET DATA-SET-DESCRITOR ADDRESS BIS #OUTFSW,FLAGS$ ; Set the bit to say we had a file 30$: MOV #LSTFDB,R0 ; SET FILE-DESCRIPTOR-BLOCK MOV #,R1 ; AND FILE-NAME-BLOCK FOR PARSE CALL .PARSE ; ---AND PARSE IT! BCS PARSER ; BR IF FAILED CALL .OPFNB ; OPEN THE FILE BCC 40$ ; BR IF A-OK FERR OPNO ; FATAL OPEN ON OUTPUT FILE ; 40$: MOV #CSIBLK,R0 ; SET CSI BLOCK CALL .CSI2 ; GET COMMAND FOR UFD TO SORT BCS CS2IER ; INPUT SPEC ERROR BITB #FD.REC,F.RCTL+LSTFDB ; RECORD DEVICE? BEQ 45$ ; BR IF NO BIT #ATSW,SWMS2$ ; Attaching if terminal? BEQ 45$ ; If EQ no - omit attach BIT #HESW!IDSW!SISW,SWMS2$ ; A proper listing? BNE 45$ ; If NE no - don't attach BIT #LISW!MISW!FUSW,SWMSK$ ; Sure? BEQ 45$ ; If EQ no - don't attach JSR R0,ATTDET ; TRY TO ATTACH .WORD IO.ATT ; 45$: BIT #SESW,SWMSK$ ; WAS /SE SWITCH SPECIFIED? ;BT001 BEQ 46$ ; IF EQ NO - PROCEED ;BT001 BIC #,SWMS2$ ; NO IMPLICIT WILDCARDING WITH /SE ;BT001 46$: ;BT001 BITB #CS.MOR,C.STAT+CSIBLK ; CHECK FOR INVALID SYNTAX BNE CMDERR ; BR IF THERE BITB #CS.NMF,C.STAT+CSIBLK ; WAS A NAME FIELD SPECFIED? BNE 47$ ; BR IF YES ;BT002 BIT #SESW,SWMSK$ ; WAS SELECT SWITCH SPECIFIED? ;BT002 BNE SETUP ; BR IF YES ;BT002 BIT #DESW,SWMSK$ ; WAS /DE SPECIFIED WITHOUT /SE OR NAME FIELD? ;BT002 BEQ SETUP ; BR IF NO ;BT002 BR CS1ERR ; SIGNAL ERROR CONDITON - CALL IT SYNTAX ERROR ;BT002 47$: ;BT002 MOV C.FILD+2+CSIBLK,R1 ; GET STRING ADDRESS ;**-1 MOV C.FILD+CSIBLK,R0 ; NOW LENGTH CLR C.FILD+CSIBLK ; DONT LET PARSE SEE NAME MOV #SEBUF$,R2 ; STRING BUFFER ADDRESS BIT #SESW,SWMSK$ ; WAS SELECT SW SPECIFIED? BEQ 50$ ; BR IF NO-NAME IS IMPLIED SELECT TSTB (R2) ; WAS A STRING GIVEN? BNE CS1ERR ; 2 SELECT STRINGS IS A COMMAND ERROR ; 50$: BIS #SESW,SWMSK$ ; EFFECT A SELECT ; 60$: MOVB (R1)+,(R2)+ ; COPY A BYTE DEC R0 ; MOVE ENTIRE STRING? BLE 70$ ; BR IF YES CMP R2,#SEBUF$+19. ; RUN OUT OF SPACE? BLO 60$ ; IF NO-LOOP AGAIN ; 70$: CLRB (R2) ; SET SENTINEL FOR STRING END SETUP: BIT #HESW,SWMS2$ ; Help switch? BEQ 5$ ; If EQ no - process normally DIR$ #HLSPWN ; Yes - ask for help WTSE$S #1 ; Wait for it to finish CLOSE$ #LSTFDB ; Close the Output File CLOSE$ #UFDFDB ; and the input one JMP LOOP ; Get next command ; 5$: BIT #SESW,SWMSK$ ;DOING SELECTIVE SEARCH? BEQ 70$ ;IF EQ NO - OMIT CHECKS CLR R1 ;NO DOT FOUND YET MOV #SEBUF$,R0 ;GET BUFFER ADDRESS 10$: TSTB (R0) ;FIND TERMINATING NULL? BNE 30$ ;IF NE NO - CARRY ON LOOKING TST R1 ;FOUND A DOT? BNE 20$ ;IF NE YES - DON'T PUT ANOTHER IN MOVB #'.,(R0)+ ;NO - INSERT ONE CMPB -2(R0),#'* ; DID ORIGINAL SEARCH STRING END IN '*'? ;BT002 BNE 20$ ; IF NE NO - DO NOT USE WILDCARD TYPE ;BT002 MOVB #'*,(R0)+ ;If no . then wildcard extension 20$: MOVB #';,(R0)+ ;AND SEMI-COLON (OR WE WOULDN'T BE HERE) MOVB #'*,(R0)+ ; If no ; then wildcard version CLRB (R0)+ ; INSERT TERMINATING NULL ;BT002 BR 70$ ;CARRY ON 30$: CMPB (R0),#'. ;FOUND A DOT? BNE 40$ ;IF NE NO - KEEP LOOKING INC R1 ;YES - FLAG IT INC R0 ;SET TO NEXT CHAR BR 10$ ;AND CHECK IT ; 40$: CMPB (R0),#'# ;FOUND A HASH? (I.E. A SEMI-COLON) BNE 45$ ;IF NE NO - KEEP LOOKING MOVB #';,(R0) ;YES - REPLACE IT WITH A SEMI-COLON 45$: CMPB (R0)+,#'; ;FOUND A SEMI-COLON? BNE 10$ ;IF NE NO - CHECK NEXT ONE TST R1 ;YES - HAVE WE HAD A PERIOD? BNE 70$ ;IF NE YES - EXIT OK DEC R0 ;SET BACK TO SEMI-COLON MOV R0,-(SP) ;STORE IT ON THE STACK 50$: TSTB (R0)+ ;FIND THE NULL BNE 50$ ; MOV R0,R1 ;SAVE ADDRESS INC R1 ;SHOVE UP ONE TO ALLOW ROOM FOR DOT ;BT002 60$: MOVB -(R0),-(R1) ;SHIFT THE BYTES UP ONE ;BT002 CMP R0,(SP) ;DONE THE LOT? ;**-3 BNE 60$ ;NO - DO ANOTHER MOV (SP)+,R0 ; Get address of ; back MOVB #'.,(R0)+ ; Insert a . 70$: MOV #LINSZ$,R0 ; POINT AT LINE SIZE SW VALUE ;**-1 TST (R0) ; DID USER SPECIFY VALUE? BNE 80$ ; BR IF YES! MOV LSTFDB+F.BBFS,(R0) ; SET DEVICE BUFFER SIZE FOR LINE SIZE 80$: CMP (R0),#72. ; CK LINE SIZE AGAINST MIN BHIS 90$ ; BR IF SIZE OK MOV #72.,(R0) ; SET ACCEPTABLE VALUE 90$: CMP (R0),#132. ; NOW CK AGAINST MAX BLOS 100$ ; BR IF OK MOV #132.,(R0) ; SET ACCEPTABLE LINE SIZE 100$: LST1: MOV #TDBUF$,R0 ; POINT AT DATE BUFFER MOV #HDBUF$,R1 ; SCRATCH AREA GTIM$S R1 ; FIND THE TIME CALL $DAT ; CONVERT DATE TO NORMAL FORM 10$: MOVB #40,(R0)+ ; SEPARATE DATE AND TIME MOV #TDTIM$,R0 ; GET ADDRESS FOR TIME MOV #2,R2 ; SET TO CONVERT HR,MIN CALL $TIM ; AND CONVERT THE TIME BIT #DASW,SWMSK$ ; DATE SELECT BEQ 30$ ; BR IF NO BIT #AFSW!BESW!AESW!BFSW,SWMSK$ ; JUST /DA SPECIFIED? BEQ 15$ ; IF EQ YES, USE /AF BUFFERS BIT #AFSW!AESW,SWMSK$ ; /AF SPECIFIED? BEQ 23$ ; IF EQ NO - JUST SET UP /BE 15$: MOV #AFBUF$,R1 ; SET TO POINT AT FIRST SW BUFFER TST (R1) ; ANY DATE SUPPLIED? BNE 20$ ; BR IF YES-USE USER SUPPLIED DATE MOV #TDBUF$,R1 ; IF NON SUPPLIED-USE TODAY! BISB #'0,(R1) ; FIRST CHARACTER MUST BE NUMERIC 20$: CALL CNVDAT ; CHANGE TO INTEGER FORMAT MOV R2,AFBUF$ ; SAVE TARGET DATE MATCH MOV R3,AFBUF$+2 ; SAVE TARGET TIME MATCH 23$: BIT #AFSW!BESW!AESW!BFSW,SWMSK$ ; JUST /DA GIVEN? BNE 25$ ; IF NE NO - CARRY ON MOV AFBUF$,BEBUF$ ; YES - SET /BE FROM /AF MOV AFBUF$+2,BEBUF$+2 ; BIS #AESW!BESW,SWMSK$ ; Set the other flags BR 30$ ; AND CARRY ON 25$: MOV #BEBUF$,R1 ; SET TO POINT AT SECOND SW BUFFER TST (R1) ; ANY DATE SUPPLIED? BNE 27$ ; BR IF YES-USE USER SUPPLIED DATE MOV #TDBUF$,R1 ; IF NON SUPPLIED-USE TODAY! BISB #'0,(R1) ; FIRST CHARACTER MUST BE NUMERIC 27$: CALL CNVDAT ; CHANGE TO INTEGER FORMAT MOV R2,BEBUF$ ; Save Target Date Match MOV R3,BEBUF$+2 ; Save Target Time Match ; 30$: MOV SWMSK$,R1 ; WE DON'T NEED TO SORT IF THESE ARE OFF BIC #^C,R1 ;BT001 BNE 35$ ;BT001 BIT #WBSW,SWMS2$ ; /WB SPECIFIED? ;BT001 BNE 35$ ; IF NE YES, DO NOT TURN OFF SORT ;BT001 BIC #SRSW,SWMS2$ ;**-2 ; 35$: BITB #CS.WLD,C.STAT+CSIBLK ; ANY WILD CARDS AROUND HERE? BEQ OPN1 ; BR IF NO! MOV C.DIRD+2+CSIBLK,R3 ; GET ADDRESS OF DIRECTORY STRING MOV C.DIRD+CSIBLK,R0 ; NOW LENGTH BEQ OPN1 ; BR IF NO DIRECTORY STRING 40$: DEC R0 ; COUNT DOWN NUMBER CHARS TO SCAN BMI OPN1 ; BR IF DIDN'T FIND WILD CARD FLAG CMPB (R3)+,#'* ; IS THAT A WILD CARD FLAG? BNE 40$ ; BR IF NO INC NXUIC$ ; SET UIC TO START AT 1 MOV C.DIRD+2+CSIBLK,R3 ; POINT AT DIRECTORY DESC. CLR WCGRP$ ; ASSUME WILD GROUP INC R3 ; SKIP [ CMPB #'*,(R3)+ ; IS IT WILD? BEQ 70$ ; BR IF YES 60$: CMPB #',,(R3)+ ; LOOK FOR END OF NUMBER BNE 60$ ; BR IF NOT FOUND MOV R3,R1 ; COPY START OF USER NUMBER DEC R1 ; BACK UP TO COMMA MOV #'[,R2 ; SET OTHER END OF FIELD CALL GETUIC ; CONVERT TO RAD50 MOV R1,WCGRP$ ; SAVE SELECTED GROUP 70$: CMPB #'],(R3)+ ; LOOK FOR END OF USER NUMBER BNE 70$ ; BR IF NOT FOUND CLR WCUSR$ ; ASSUME WILD CARD USER MOV R3,R1 ; COPY PLACE IN STRING CMPB -(R1),-(R1) ; BACK UP TO LAST DIGIT IN NUMBER CMPB #'*,(R1)+ ; IS IT WILD BEQ 80$ ; BR IF YES MOV #<',>,R2 ; SET END OF FIELD CALL GETUIC ; CONV TO RAD50 FORM MOV R1,WCUSR$ ; SAVE THAT CODE 80$: MOV #LSTNX$,(SP) ; SET RETURN ADDRESS OPN1: MOV #UFDFDB,R0 ; GET FDB MOV #,R1 ; FILE NAME BLOCK MOV #,R2 ; DATA SET DESCRIPTOR MOV #DFNB,R3 ; DEFAULT NAME BLOCK TST NXUIC$ ; DOING WILD CARD OPERATION? BEQ 10$ ; BR IF NO CALL .PRSDV ; PARSE DEVICE ONLY BCC INIEX ; EXIT INIT IF OK FERR PRSE ; INDICATE ERROR 10$: CALL .PARSE ; BCC SRTDIR ; BR IF OK ; FERR DIRF ; DIRECRORY FIND ERR ; SRTDIR: ; ; DIRECTORY FIND WAS SUCCESSFUL ; MOV F.FNB+N.DID(R0),SAVDID ;SAVE DIRECTORY ID MOV F.FNB+N.DID+2(R0),SAVDID+2 MOV F.FNB+N.DVNM(R0),SAVDVN ;---AND DEVICE NAME MOV F.FNB+N.UNIT(R0),SAVUNM ;ALSO UNIT NUMBER MOV N.DID(R1),N.FID(R1) ;COPY DIRECTORY I.D. CLR N.DID(R1) ;REMOVE DIRECTORY ID MOV N.DID+2(R1),N.FID+2(R1) ;TO FILE ID SPACE MOV N.DID+4(R1),N.FID+4(R1) ;JUST FOR "GRINS", THIS TOO! MOVB #FO.RD!FA.SHR,F.FACC(R0) ;ASSUME ONLY READ ACCESS BITB #WBSW,SWMS2$ ;DOES HE WANT IT WRITTEN BACK? BEQ 5$ ;BR IF NO MOVB #FO.MFY,F.FACC(R0) ;REQUEST ACCESS OF FILE FOR MODIFY 5$: MOV #SAVDID,READHD+Q.IOPL ;SET DIRECTORY ID FOR HEADER READ ALUN$S #UFDLUN,SAVDVN,SAVUNM DIR$ #READHD ;REQUEST THE READ BCC 20$ ;BR IF AOK CALL ALERR ;DIAGNOS ERR BR 5$ ;RETRY IF THAT IS POSIBLE 20$: WTSE$S #EFN1 ;WAIT FOR THAT TO STOP MOVB HDBUF$+1,R1 ;GET OFFSET TO IDENT AREA ADD #I.FNAM,R1 ;POINT AT FILE NAME ADD #HDBUF$,R1 ;ADD IN OFFSET FOR BUFFER MOV (R1)+,F.FNAM(R0) ;SET TOP 1/2 OF DIRECTORY NAME MOV (R1),F.FNAM+2(R0) ;-AND BOTTOM 1/2 RETURN INIEX: MOV F.FNB+N.DVNM(R0),SAVDVN ; SAVE DEVICE NAME MOV F.FNB+N.UNIT(R0),SAVUNM ;ALSO UNIT NUMBER ALUN$S #UFDLUN,SAVDVN,SAVUNM RETURN ; ; GETUIC---LOCAL SUBROUTINE TO CONVERT A 1 TO 3 BYTE NUMERIC STRING ; INTO 3 RADIX 50 CHAR FORMAT CONSISTANT WITH DIRECTORY NAMES GETUIC: MOV #UICS$,R0 ; POINT AT 4 BYTE STRING BUFFER MOV #"00,(R0)+ ; ASSUME LEADING ZEROS NEEDED CLRB (R0)+ ; ADVANCE PONTER 10$: CMPB -(R1),R2 ; IS THIS TERMINAL CHAR? BEQ 20$ ; BR IF YES MOVB (R1),-(R0) ; NO-SET DATA INTO STRING BR 10$ ; TRY AGAIN 20$: MOV #UICS$,R0 ; RESET POINTER CALL $CAT5 ; CONVERT TO RAD50 RETURN .END