Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / bdos / dosplsor.ark / FDATE.MAC < prev next >

Wrap

Text File | 1986-10-29 | 14.1 KB | 740 lines

title 'FDATE list file dates' ; ver equ 10 cr equ 0dh lf equ 0ah tab equ 09h ; ; CPM/DOS+ syscall values @cin equ 1 @cout equ 2 @csta equ 11 @seldk equ 14 @srch1 equ 17 @srchn equ 18 @curdk equ 25 @stdma equ 26 @usrcd equ 32 ; ; CPM/DOS+ definitions reboot equ 0 sysfnc equ reboot+5; connector to BDOS system defdma equ reboot+080h ; ; UPPER case in following line for M80. SLRMAC does not need the file. INCLUDE Z80.LIB ; ; --------- Start ---------- ; jmp begin ; maxusr: db 31 ; ; Upshift (a) if lower case alpha. ; a,f upshft: cpi 'a' rc cpi 'z'+1 rnc ani 05fh ret ; ; Check (a) valid digit, carry if not ; f qnum: cpi '0' rc cpi '9'+1 cmc ret ; ; crlf to console ; a,f crlf: mvi a,cr call couta mvi a,lf ; " " ; console output from (a) ; a,f couta: push d mov e,a mvi a,@cout call bdos pop d ret ; ; Numeric 1..99 to console. Convert to Ascii, no zero suppress ; a,f putnum: push b mvi c,'0'-1 pn1: inr c adi -10 jrc pn1 adi 10 push psw mov a,c call couta pop psw pop b adi '0' jr couta ; ; Test for any console character ready. If so purge it and ; return nz flag. Else return z flag. Nulls absorbed ; a,f qbreak: mvi a,@csta call bdos rz mvi a,@cin jr bdos ; ; search next on (de)^. Z flag for failure, exit (a) incremented ; a,f srchn: mvi a,@srchn ; " " ; execute functions, Z flag for 0ffh, increment return value ; a,f sfncr: call bdos inr a ret ; ; search for file fcbdrv. Z flag for failure, exit (a) incremented. ; a,f,d,e ffind: lxi d,fcbdrv mvi a,@srch1 jr sfncr ; ; Find current logged disk qdisk: mvi a,@curdk jr bdos ; ; Set user to absolute value in fcbusr and select on BDOS. ; Do not modify or select drive. Leave drv/usr in bc ; Update fcbusr to absolute value ; a,f,b,c,e setusr: lbcd fcbusr; c := user, b := drive mov a,c ora a cm quser; default, get current user mov c,a; now an absolute value sbcd fcbusr ; " " ; set user to a ; a,f,e susera: mov e,a jr suser ; ; find current user code ; a,f,e quser: mvi e,0ffh ; " " ; set user (e) ; a,f suser: mvi a,@usrcd ; " " ; execute bdos call, return (a), set flags. Preserve other registers ; This is the sole connection to the outside world. ; a,f bdos: push h push d push b pushix mov c,a call sysfnc ora a; set flags on return value popix pop b pop d pop h ret ; ; set drive/user from fcbusr/fcbdrv setdu: call setusr; and b := drv, c := usr mov a,b dcr a cm qdisk; get default disk mov b,a inr b sbcd fcbusr; jam id ; " " ; select drive (a). DOS handles redundancies. ; a,f,e seldka: ani 0fh mov e,a mvi a,@seldk jr bdos ; ; Parse the next field from the command line (IX^) into fcbdrv. Any ; drive/user specifications are recorded in fcbdrv and fcbusr ; (which default to 0 and -1 respectively). name and type are parsed ; into fname and ftype, blank padded, with any '*'s expanded into ; '?'s, and the fields are blank padded. At exit IX points to the ; field terminating delimiter char and lastwd points to the 1st char. ; a contains a count of '?' characters in fname & ftype fields, with ; flags set on it. Illegal chars. cause abort. ; a,f,b,c,d,e,h,l,ix parse: xra a ; " " ; Entry to parse 2nd drive spec. for xcom, when a = 010h parsef: lxi h,fcbusr call index; select fcb or alternate fcb call skipbk; skip any leading blanks sixd lastwd; save marker for errors call getdu; c := user, b := drv mov m,c; set fcbusr inx h mov m,b; set fcbdrv, set up for ldfld call lastch cpi ':' cz nextch; Absorb any du terminating ':' mvi b,8 push h call ldfld; fill the name field call lastch cpi '.' cz nextch; Absorb any name terminating '.' mvi b,3; (else terminator blank fills) call ldfld; fill the type field mvi b,3 parse1: inx h mvi m,0 djnz parse1; zero ex, s2, s1 fields lxi b,11 shl 8; b := 11, c := 0 pop h mvi a,'?' parse2: inx h cmp m jrnz parse3 inr c parse3: djnz parse2; count the '?'s in fname/ftype mov a,c ora a; z flag for no wild cards ret ; ; load up to (b) chars from (ix)^ up to (hl)^ up. ; skip to delimiter. Implement any wild cards on "*" ; blank fill if less than (b) chars available. ; Upshift any lower case characters. ; a,f,b,h,l,ix ldfld: call lastch; on (ix)^ and load it jrz ldfld4; delimiter inx h cpi '*' jrnz ldfld1 mvi m,'?'; expand '*' jr ldfld2; dont skip past it ldfld1: call upshft; upshift any lower case mov m,a call nextch ldfld2: djnz ldfld call lastch; on (de)^ and load it rz; a delimiter ldfld3: call nextch; else skip to a delimiter rz jr ldfld3 ldfld4: inx h mvi m,' '; blank fill djnz ldfld4 ret ; ; getdu returns any "du" spec. in b and c, with c = user, b = drv ; The default user is signified by a -1 value, default drive by 0 ; At entry, IX points to the start of the field to be parsed. At ; exit, either IX is unchanged (no du found), or points to ':' ; a,f,b,c,d,e,ix getdu: lxi b,0ffh; set defaults pushix pop d; pre-scan for valid du field ldax d call upshft; 2.1 - No ':' abort here call qnum jrnc getdu1; 1st char digit, no d cpi '@' rc; < '@', no du spec cpi 'P'+1 rnc; > P, no du spec inx d ldax d cpi ':' jrz getdu2; d spec only call qnum rc; no 'du' spec getdu1: inx d ldax d cpi ':' jrz getdu2; du spec found call qnum rc; no du spec inx d ldax d cpi ':' rnz; not terminal ':', no du spec ; " " ; prescan found a valid du format, now load it getdu2: call lastch call qnum jrnc getdu3; digit, no d portion call upshft sui '@' mov b,a; save d portion call nextch getdu3: cpi ':' rz; no 'u' portion ani 0fh mov c,a call nextch rz; ':', 1 digit only call dstep; incorporate call nextch; and advance to the (known) ':' lda maxusr cmp c jrc help; User # too large ret ; ; Decimal input step. Carry for overflow. c is accumulator, a digit ; a,f,c,d dstep: ani 0fh mov d,a mov a,c cpi 26 cmc rc; overflow add a add a add c; 5* add a; 10* add d mov c,a; result ret; cy for overflow ; ; Get next character from line. Z flag for a delimiter, ; and abort if the character is illegal. Do not advance past eoln. ; Return char in a and leave IX pointing to it. cy for eoln ; a,f,ix nextch: ldx a,+0 ora a jrz lastch; don't advance past eol inxix ; " " ; Return last character, as above. Abort if invalid, cy for eoln ; a,f lastch: ldx a,+0 ora a stc rz; null is a delimiter cpi '='; and all these rz cpi '_' rz cpi '.' rz cpi ':' rz cpi ';' rz cpi '<' rz cpi '>'; Redirection chars rz cpi ','; Operand separator rz cpi '|'; Piping separator rz; ; " " ; Check white space, abort on illegal chars. z flag for white qwhite: cpi tab rz; white space is a delimiter cpi ' ' jrc help; abort on illegals ret ; ; skip blanks and tabs in input line. Abort on illegal chars. ; return the 1st non-blank char. found. ; a,f,ix skipbk: call lastch rc; eoln skip1: call qwhite rnz; not white space ; " " ; Effectively "call nextch ! call skipbk" next: call nextch jrnc skip1 ret; eoln ; ; hl := hl + a ; a,f,h,l index: add l mov l,a rnc inr h ret ; ; load (a+c)th char from defdma array ; a,f,h,l idxac: lxi h,defdma add c call index mov a,m ret ; ; crlf, then tstr ; a,f,h,l tstrc: call crlf ; " " ; string (hl) to console until 0 byte ; a,f,h,l tstr: mov a,m ora a rz inx h call couta jr tstr ; help: lxi h,hlpmsg ; " " ; exit with message msgxit: call tstrc jr done ; ; no time stamp message & exit notime: lxi h,notimemsg jr msgxit ; ; jam fcb to all wild cards mkwild: lxi h,fname mvi b,11 mkwld1: mvi m,'?' inx h djnz mkwld1 ret ; ; one blank to console blk: mvi b,1 ; " " ; blank to console blks: mvi a,' ' call couta djnz blks ret ; ; Main program operation begin: lxi h,0 dad sp shld stksav lxi sp,stksav lxi h,defdma mov a,m ora a inx h push h popix; init input scanner jz help; empty input line call skipbk jc help; or only blanks call parse lda fname cpi ' ' cz mkwild; must be a du spec call setdu call ffind; sets de := ^fcbdrv cnz flist; If any found, list them done: lhld stksav sphl ret ; ; List files found flist: push psw lda defdma + 060h cpi 021h jrnz notime; and abort lxi h,head call tstrc pop psw flist1: dcr a; compensate for file-find inr push psw mvi c,060h add a; 2* mov b,a add a; 4* add a; 8* add b; 10* adi 2; displacement of 1st stamp call idxac; point to time stamp lxi d,fcreat lxi b,10 ldir; move into fcb on 1st ; really want min of all create, max of modify/access for file pop psw rrc rrc rrc ani 060h mvi c,1 call idxac; point to DIR entry call crlf lda fcbdrv adi '@' call couta lda fcbusr call putnum mvi a,':' call couta mvi b,8 call tname mvi a,'.' call couta mvi b,3 call tname mvi b,2 call blks call dates call qbreak rnz call srchn jnz flist1 ret ; dates: lhld fcreat call date mvi b,2 call blks lhld fmodif call date call blk lhld fmodif+2 call time mvi b,2 call blks lhld facces call date call blk lhld facces+2 call time ret ; date: mvi b,8 mov a,h ora l jz blks call drtodate mov a,c; year call t2hx mvi a,'/' call couta mov a,d call t2hx mvi a,'/' call couta mov a,e jmp t2hx ; time: mvi b,5 mov a,h ora l jz blks mov a,l call t2hx mvi a,':' call couta mov a,h ; " " t2hx: push psw rlc rlc rlc rlc call t1hx pop psw ; " " t1hx: ani 0fh adi 090h daa aci 040h daa jmp couta ; ; type b chars from hl^ tname: mov a,m ani 07fh call couta inx h djnz tname ret ; ; days per month, except leap year. Leading dummy 0 for month 0 mtbl: db 0,31,28,31,30,31,30,31,31,30,31,30,31 ; ; Convert (a) in binary to BCD. No overflow check. Return z flag. ; a,f binbcd: push b lxi b,0affh; b := 10, c := -1 bbcd1: inr c ! sub b !jrnc bbcd1; divide by 10 add b; correct remainder mov b,a mov a,c; quotient add a ! add a ! add a ! add a; * 16. Cy for o'flow add b; + remainder. clears cy pop b ret ; ; PROCEDURE drtodate(thedate : integer; VAR yr, mo, day : integer); ; (* 1 Jan 1978 corresponds to Digital Research date = 1 *) ; (* BUG - cannot handle negative values for dates > 2067 *) ; ; VAR ; i, y1 : integer; ; dayspermonth : ARRAY[1..12] OF 1..31; ; ; BEGIN (* drtodate *) ; FOR i := 1 TO 12 DO dayspermonth[i] := 31; ; dayspermonth[4] := 30; dayspermonth[6] := 30; ; dayspermonth[9] := 30; dayspermonth[11] := 30; ; IF thedate > 731 THEN BEGIN (* avoid overflows *) ; yr := 1980; thedate := thedate - 731; END ; ELSE BEGIN ; thedate := thedate + 730; yr := 1976; END; ; (* 0..365=y0; 366..730=y1; 731..1095=y2; 1096..1460=y3 *) ; i := thedate DIV 1461; thedate := thedate MOD 1461; ; y1 := (thedate-1) DIV 365; yr := yr + y1 + 4*i; ; IF y1 = 0 THEN (* leap year *) dayspermonth[2] := 29 ; ELSE BEGIN ; thedate := thedate - 1; (* 366 -> 365 -> 1 Jan *) ; dayspermonth[2] := 28; END; ; day := thedate - 365*y1 + 1; mo := 1; ; WHILE day > dayspermonth[mo] DO BEGIN ; day := day - dayspermonth[mo]; ; mo := succ(mo); END; ; END; (* drtodate *) ; ; Incorporate (a) in year (c), overflows to century (b) addyr: add c jnc addyr1; <256 sui 100; 256..276 jmp addyr2 addyr1: dcr b addyr2: inr b sui 100 jnc addyr2 adi 100; b = century, c = year MOD 100 mov c,a ret ; ; divide hl by -de, rdr to hl, quotient to a divd: mvi a,-1 divd1: inr a dad d jc divd1 push psw mov a,l sub e mov l,a mov a,h sbb d mov h,a pop psw ret ; ; Input : hl = drdate (days since 78/1/1, 1 = 78/1/1) ; Output : b, c, d, e = cent, year, month, day (binary) ; a,f,b,c,d,e,h,l drtodate: lxi b,256*19 + 76; 731 represents 80/1/1 push h lxi d,-731 dad d pop h jnc drd1; before 80/1/1 dad d; on or after 80/1/1 mvi c,80; now 0 represents 80/1/1 jmp drd2 drd1: lxi d,730 dad d; now 731 represents 78/1/1 drd2: lxi d,-1461 call divd; get quad years since base (in c) add a add a; 4 * i. 180 max call addyr; yr := yr + 4 * i mov a,h ora l jz drd3; At Jan 1, leap year dcx h; thedate := thedate - 1 lxi d,-365; so year thresholds come out right call divd; thedate := thedate MOD 365 push psw; y1 := a := thedate DIV 365 call addyr; yr := yr+y1 pop psw; 0 for leapyear jnz drd5; not a leap year inx h; thedate := thedate+1 (1..365) drd3: mvi a,29 sta mtbl+2 drd5: xchg lxi h,mtbl push b mvi b,0; mo := 0 drd6: inx h; WHILE inr b; day := day-dayspermo[mo := mo+1] >= 0 mov a,e; DO (* again *) sub m mov e,a mov a,d sbi 0 mov d,a jnc drd6 mov a,e; day := day+dayspermo[mo] add m mov e,a; range 0..pred(dayspermo[mo]) adc d sub e mov d,a xchg mov d,b pop b mov e,l inr e; make result 1 based mvi a,28 sta mtbl+2; restore month table mov a,b call binbcd mov b,a mov a,c call binbcd mov c,a mov a,d call binbcd mov d,a mov a,e call binbcd mov e,a ret ; hlpmsg: db 'FDATE ver. ' db ver / 10 + '0', '.', ver mod 10 + '0' db 'by C.B. Falconer',cr,lf,lf db 'Usage: FDATE [d[u]:][afn.aft]',cr,lf db 'shows timestamps for DOS+ directories',0 notimemsg: db 'No time stamps on this volume',0 head: db 'd/u:Filename.Typ Created ' db '---Modified--- ---Accessed---',cr,lf db '--- -------- --- -------- ' db '-------------- --------------',0 ; ; NOTE: the ",0" in ds statements ensures the areas are 0 filled ; ; File control block and receiver of parse fields (34 bytes) fcbusr: ds 1 fcbdrv: ds 1 fname: ds 8 ftype: ds 3 ds 3 ds 1 fcreat: ds 2; date created or disk map fmodif: ds 4; date/time modified facces: ds 4; date/time accessed ; ; Parsing lastwd: ds 2; start of current word in iobuff ; ds 64; stack space stksav: ds 2; save entry stack ; end 0▐