Код:
.IF NE DATE$$ ;If DATE command
.SBTTL DATE Command
;+
; "Thirty days hath September, April, June, and November;
; All the rest have thirty-one, excepting February alone,
; And that has twenty-eight days clear
; And twenty-nine in each leap year."
; - Richard Grafton,"Abridgement of the Chronicles of England"
;-
.ENABL LSB
OVCMD DATE
.ADDR #<TMRLST>,R3 ;Point to list
MOV R3,R0 ;Copy pointer to .GTIM area
MOV R3,-(R0) ;Put in address
TST -(R0) ;Point to parameter block
EMT ...GTI ;Do .GTIM EMT
.ADDR #<MONTHS>,R4 ;Point to ASCII month names
MOV @#$SYPTR,R0 ;Point to monitor
TSTB @R5 ;Want to print it?
BEQ 50$ ;Yah
CMPB @R5,#<SPACE> ;In case he left off space
BEQ 10$ ;Ok
INC R5 ;No space, don't lose first digit
10$: CLR R1 ;Clear date accumulator
JSR R3,NUMK ;Get day in R1
.BYTE <0.>, <31.-0.>
SWAB R1 ;Put it in place
ASR R1
ASR R1
ASR R1
INC R5 ;Fix and
MOV R5,R3 ;Save ptr to -MON-YY
20$: ADD #<2000>,R1 ;Bump date to next month
TSTB 1(R4) ;End of list ?
BEQ 120$ ; Drat
MOV R3,R5 ;Point R5 to given -MON-
MOV R4,R2 ;Copy ptr into list
CMP (R4)+,(R4)+ ;Advance for next time
30$: MOVB (R2)+,-(SP) ;Push character from table
BICB #<LOW2UP>,@SP ;Make it uppercase
MOVB -(R5),-(SP) ;Push given character
BICB #<LOW2UP>,@SP ;Make it uppercase
CMPB (SP)+,(SP)+ ;Are they the same?
BNE 20$ ;Branch if not - try next month
40$: CMP R2,R4 ;Done 5?
BLOS 30$ ;Keep trying
CALL YEARK ;Get the year
TSTB @R5 ;End of line?
BNE 120$ ;No, error
.ADDR #<TMRLST>,R0 ;Point to list
MOV #<DTM.NA>,@R0 ;Don't set the time
MOV R1,-(R0) ;Do set the date
MOV R0,SDTM+A.DTTM-<TMRLST-2>(R0) ;Point argument block at list
ADD #<SDTM-<TMRLST-2>>,R0 ;Point to argument block
EMT ...SDT ;Set the date, but not the time
RETURN
............
;+
; Print the date
;-
50$: MOV DATES-$RMON(R0),R2 ;Get date from monitor data base
BEQ 110$ ;If zero, give "No Date" ;147
MOV R2,R1 ;Make a copy of it
BIC #^C<DA.MON>,R1 ;Isolate the month field
ASR R1 ; and right justify it
ASR R1 ; ...
SWAB R1 ; ...
BEQ 120$ ;If zero, invalid month
CMP R1,#12. ;Is it within range?
BGT 120$ ;Nope...
DEC R1 ;Make month range 0-11 (not 1-12)
MOV R2,R0 ;Make another copy
BIC #^C<DA.DAY>,R0 ;Isolate the day
ASL R0 ; and right justify it
ASL R0 ; ...
ASL R0 ; ...
SWAB R0 ; ...
BEQ 120$ ;If zero, invalid day
MOV R2,-(SP) ;Make another (temp) copy
BIC #^C<DA.AGE>,@SP ;Isolate the RT epoch
BIC #^C<DA.YR>,R2 ;Isolate the year
SWAB @SP ;Right justify
ASL @SP ; ...
ASL @SP ; ...
SWAB @SP ; ...
BEQ 70$
60$: ADD #32.,R2 ;Increase by an epoch
70$: DEC @SP
BGT 60$
TST (SP)+ ;Discard count...
ADD R1,R4 ;Add in month offset
MOVB <MONTAB-MONTHS>(R4),-(SP) ;Get the month's length
SUB R1,R4 ;Restore R4...
CMP R1,#1 ;Is this february?
BNE 80$ ;Nope, leave length alone
; ** NOTE ** Leap years are those years divisible by 4, but not
; by 100, unless they are also divisible by 400.
; In the range supported by RT (1972 - 2099), all years
; divisible by 4 are leap years (including 2000)
BIT #^B<11>,R2 ;Is this a leap year?
BNE 80$ ;Nope...
INC @SP ;Yes, bump length
80$: CMPB R0,(SP)+ ;Is the day number valid?
BGT 120$ ;Nope...
CALL R10ONF ;Print the day
ASL R1 ;Shift for month string
ASL R1 ; ...
ADD R1,R4 ;R4 -> month string
MOV #5,R1 ;R1 = Length of string to print
90$: .TTYOU (r4)+ ;Print a month character
SOB R1,90$ ; and loop if more to print...
MOV #19.,R0 ;R0 = First two digits of year
MOV R2,-(SP) ;@SP = Year - 1972
ADD #72.,@SP ;Adjust for RT base year (year - 1900)
CMP @SP,#100. ;Is it into 2000?
BLT 100$ ;Not yet...
INC R0
SUB #100.,@SP ;Yes, so reduce by 100
100$: CALL R10OUT ;Print the first two digits
MOV (SP)+,R0 ;Get the last two digits
CALL R10OUT ; and print them
K0CRLF: OCALLR KCRLF ;Print CR LF and exit
............
;+
;ERROR
110$: KMEROR <No date>,,WARN$ ;Non-fatal
............
120$:
.IF EQ CONT$N
KMEROR <Invalid date> ;Fatal
............
.IFF ;EQ CONT$N
KMEROR <Invalid date>,,WARN$ ;Non-fatal
............
.ENDC ;EQ CONT$N
;-
NUMK: OCALL DECNUM ;Get a number from the command string
MOVB (R3)+,R2 ;Get low limit
SUB R2,@SP ;Decrease number
BLE 120$ ;Too bad, below low limit
MOVB (R3)+,R2 ;Get upper limit
CMP @SP,R2 ;Too big?
BGT 120$ ;Error if so
ADD (SP)+,R1 ;Add it in to date word
RTS R3
............
YEARK: OCALL DECNUM ;Get a number from the command string
CMP @SP,#100. ;Is it a two-digit year?
BLT 130$ ;Yes...
CMP @SP,#1972. ;No, is it a valid year?
BLT 120$ ;Nope...
CMP @SP,#2099. ;Maybe, check upper limit
BGT 120$ ;Nope...
SUB #1900.,@SP ;Reduce for epoch/year determination
130$: SUB #72.,@SP ;Reduce by RT base year
BMI 120$ ;Anything below 1972 is invalid
140$: SUB #32.,@SP ;Deduct an epoch
BMI 150$ ;We've found the correct one...
ADD #^O<40000>,R1 ;Not in this one, try again...
BR 140$
150$: ADD #32.,@SP ;Correct the year
ADD (SP)+,R1 ; and add it in
RETURN
............
.DSABL LSB
.ENDC ;NE DATE$$
Сообщение от AFZ
Ответить с цитированием
Размещение рекламы на форуме способствует его дальнейшему развитию 
