.title date4 .ident /V01.00/ ; Y2K-compatible DATE routine for RSX Fortran-77 (by N.Z. 13-Feb-1999) ; From disassembly of same (identical function except for year display); ; also adds a four-digit DATE4 that F77OTS does not have. ; ; Calling sequence: ; ; character*9 datbuf ; character*11 datbf4 ; call date(datbuf) ; call date4(datbf4) ; print*,date,date4 ! e.g. "13-FEB-99 13-FEB-1999" ; ; When linking, refer to this module before referring to F77OTS, or ; replace the F77OTS module. Not for RT-11 use. Can be called by ; Macro-11 or other languages with normal PDP-11 R5 calling sequence; ; make sure to supply only one argument to avoid a TKTN exit or other ; non-OTS consequence of the TRAP instruction, and make sure that psect ; names not used in an incompatible fashion (e.g. $idata must be ; writable). .psect $code1,ro,i,lcl,rel,con ; put it with rest of F77 code date4:: mov #4,y4 ; indicate 4-digit display br datcom ; continue with common code date:: clr y4 ; two-digit display datcom: cmpb #1,(r5) ; one argument passed? beq 1$ ; yes, continue trap 320 ; no, give OTS error 80. br ret ; it's a nonfatal error so continue (-> RTS PC) 1$: sub #20,sp ; Make space for GTIM$ DPB on stack mov sp,r1 ; Address of GTIM$ date buf. for our later use mov r1,-(sp) ; Tell Exec. where it is too mov #1075,-(sp) ; GTIM$S DIC emt 377 ; call Exec. bcs direrr ; if err., just restore stack & return mov 2(r5),r0 ; Get addr. of F77 string to put result into mov 4(r1),r2 ; Get day as returned from GTIM$ buffer jsr pc,cb2a ; convert it movb #55,(r0)+ ; add a hyphen mov 2(r1),r2 ; get month from GTIM$ buffer asl r2 ; *2 add 2(r1),r2 ; *3 add #,r2 ; convert to offset in month table movb (r2)+,(r0)+ ; copy ASCII month to output buffer movb (r2)+,(r0)+ movb (r2)+,(r0)+ movb #55,(r0)+ ; another hyphen mov (r1),r2 ; get the year mov r3,-(sp) ; preserve reg in case someone else uses it mov #19.,r3 ; base century (high two digits of year) cmp r2,#100. ; Is it 2000. yet? blo 3$ ; No, don't add any centuries 2$: sub #100.,r2 ; Added Y2K code... inc r3 ; # of centuries since 1900 cmp r2,#100. bge 2$ ; Keep going till <100. 3$: cmp #4,y4 ; 4-digit display? bne c20 mov r2,-(sp) ; swap r2,r3 would be nice... mov r3,r2 jsr pc,cb2a ; convert upper 2 digits of year mov (sp)+,r2 c20: jsr pc,cb2a ; convert lower 2 digits of year mov (sp)+,r3 ; restore saved reg direrr: add #20,sp ; restore stack ret: rts pc ; & return ; convert binary two-digit # in R2 to ASCII in (R0)+ ; clobbers R2, advances R0. cb2a: add #366,r2 ; -10. tstb r2 ; zero or less yet? bpl cb2a ; Nope, keep taking 10's away add #27472,r2 swab r2 movb r2,(r0)+ ; transfer 10's digit swab r2 movb r2,(r0)+ ; transfer 1's digit rts pc .psect $idata,rw,d,lcl,rel,con ; F77 Impure Data area y4: .word 0 .psect $pdata,ro,d,lcl,rel,con ; F77 Pure Data area months: .ascii /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/ .psect .end