; DATE.SBR
; VER 1.0 8608.12
;
;
;
; PROPRIETARY PROGRAM MATERIAL
;
; THIS MATERIAL IS THE PROPERTY OF JEFF STUYVESANT,
; 12307 PACIFIC AVE, APT 2,MAR VISTA, CALIF. ,90066
; PERMISSION TO COPY AND USE IS GRANTED FOR
; NON-PROFIT USES ONLY.
;
; Copyright (c) 1986 JEFF STUYVESANT
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM
OBJNAM DATE.SBR
RADIX 8.
VMAJOR = 1.
VMINOR = 0.
VSUB = 0.
VEDIT = 0.
VWHO = 0.
;MACROS
DEFINE GET.D O.SET,DEST
MOV O.SET(A3),DEST
ENDM
DEFINE GET.I O.SET,DEST
MOV O.SET(A3),DEST
SWAP DEST
ENDM
DEFINE SAV.D O.SET,SORC
MOV SORC,O.SET(A3)
ENDM
DEFINE SAV.I O.SET,SORC
SWAP SORC
MOV SORC,O.SET(A3)
ENDM
;EQUATES
; DSECT
A.SIZE = 8.
A.ADDR = 4.
V.DATE = 0.
V.INTL = 0.
V.BASE = 4.
V.MODE = 8.
V.LEAP = 8.
; PSECT
PHDR -1,0,PH$REE!PH$REU
START: ; A3 POINTS TO BASE OF ARG LIST
CMPW @A3,#1 ; ONLY ONE ARG
JNE SBR.ERROR
CMP A.SIZE(A3),#10. ; 10 BYTES IN SIZE
JLO SBR.ERROR
MOV A.ADDR(A3),A3 ; GET ADDR OF VARIBLE
MOVW V.MODE(A3),D5 ; MOV MODE INTO D5
BEQ SBR.ERROR ; ERROR IF ZERO
CMPW D5,#5. ; IS IT MODE 5
JEQ MODE.5 ; BR TRUE
BHI SBR.ERROR ; ERROR IF GREATER
; PROCESS MODE 1 TO 4
GET.D V.DATE,D6 ; GET DATE'SEP
BEQ DATE.ERROR ; CANT BE ZERO
CALL $DTO.I ; CALC DATE TO INTERNAL
BEQ DATE.ERROR ; INVALID DATE IF Z FLAG
MOVW D7,V.LEAP(A3) ; SAVE LEAP'YEAR FLAG
CMPW D5,#4. ; IS IT MODE 4?
BEQ MODE.4 ; BR IF YES
; DATE ENTERED AS INTERNAL IN D6
MOV D6,D3
CALL DOW ; CALC DAY OF WEEK SAVE IN D3
CMPW D5,#2.
BLO EXIT ; LOW IS ONLY MODE 1
BEQ MODE.2 ; BR IF = MODE 2
; MUST BE MODE 3
MODE.3: ; SECOND DATE IN DATE'BASE
TST V.BASE(A3) ; BASE CANT=0
BEQ DATE.ERROR ; BR IF =
SAV.I V.INTL,D6 ; SAVE DATE AS DAYS
GET.D V.BASE,D6 ; GET DATE'BASE(AS DATE)
BEQ DATE.ERROR ; CANT BE ZERO
CALL $DTO.I ; CALC DATE TO INTERNAL
BEQ DATE.ERROR ; INVALID DATE IF Z FLAG
GET.I V.INTL,D7 ; GET DATE'SEP(AS'DAYS)
XCH D6,D7 ; SET INTO PROPER ORDER
; D6= DATE(AS DAYS [LARGER])
; D7= DATE'BASE(AS DAYS [SMALLER])
SUB.01: CMP D7,D6 ; COMPARE THE TWO DATES(AS DAYS)
BHI DATE.ERROR ; BR IF BASE > SEP.
SUB D7,D6 ; SEP-BASE= DIFFERENCE
; END OF PROGRAM
EXIT: SAV.I V.INTL,D6 ; SAVE DAYS
EXIT$: SAV.I V.BASE,D3 ; SAVE DOW
RTN
;MODE OR ARG IN ERROR
SBR.ERROR: MOV #0,V.INTL(A3) ; USED WHEN PARAMETERS
MOV #0,V.BASE(A3) ; ARE IN ERROR
SETW V.MODE(A3) ; MODE/#OF ARG ETC.
RTN
; DATA IN ERROR
DATE.ERROR: SET V.INTL(A3) ; USED WHEN VARIBLES ARE
SET V.BASE(A3) ; IN ERROR
SETW V.MODE(A3) ; DATE NOT DATE/ ETC
RTN
MODE.2: ; D6=DATE(AS DAYS)
; SUB DATE'BASE(AS DAYS) AND FINISH
GET.I V.BASE,D7 ; GET DATE'BASE(AS DAYS)
; D7= DATE(AS DAYS [LARGER])
; D6= DATE'BASE(AS DAYS [SMALLER])
BR SUB.01 ; SUB AND SAVE
MODE.4: ; D6=DATE(AS DAYS)
; ADD DATE'BASE(AS DAYS) SEND BACK
; DATE'INTERNAL
GET.I V.BASE,D7 ; GET DATE'BASE(AS DATE)
ADD D7,D6 ; CALC NEW DAYS
MOV D6,D4 ; CALL USES D4
BR CALC.INTL ; CALC NEW DATE
MODE.5:
; GET D4 AS DAYS
; RETURN DATE
MOVW #0,V.MODE(A3) ; CLEAR MODE
GET.I V.DATE,D4 ; GET DATE(AS DAYS)
BEQ DATE.ERROR ; BR IF = 0
CALC.INTL:
MOV D4,D3 ; SET UP FOR DOW
CALL DOW ; CALC DAY OF WEEK
CALL $ITO.D ; CONVERT TO DATE
BEQ DATE.ERROR ; DAYS IN ERROR
SAV.D V.DATE,D6 ; SAVE IT AND FINISH
BR EXIT$
$ITO.D: ; D4 CONTAINS DAYS TO BE CONVERTED
SAVE D0-D2,A5
SUB #2351425.,D4 ; CORRECT FROM AM FORMAT
CMP D4,#0. ; CMP TO 0
JLOS NO.GOOD ; NO GOOD IF 0 OR LESS
MOV #146097.,D6 ; SET DIVISOR INTO D6
SUB #12.,SP ; GRAB SOME WORKSPACE
LEA A6,(SP) ; A6 TO POINT TO IT
FLTOF D6,@A6 ; CONVERT D6 TO FLOAT .
ADD #6.,A6 ; POINT TO NEW LOCATION
MOV D4,D6 ; GET DAYS TO CONVERT
ADD #364.,D6 ; CORRECTION OF 1 YR-1
FLTOF D6,@A6 ; CNVT TO FLOAT .
MOV SP,A5 ; SAVE SP
FDIV A5,A6 ; DIV THE NUMBERS
MOV A6,A5 ; GET BASE OF NUMBERS
FFTOL @A5,D6 ; CNVT FROM FLOAT .->D6
ADD #12.,SP ; RESET SP
INC D6 ; ADD ONE TO ANSWER
MOV D4,D0 ; SAVE IT
ADD #364.,D0 ; ADD CORRECTION 1 YR-1
SUB D6,D0 ; CALC DIFERENCE
MOV D0,D1 ; SAVE IT
P2: ; CALCULATION PART TWO
DIV D0,#36524. ; DIVIDE D0
AND #177777,D0 ; ELIMINATE REMAINDER
INC D0 ; ADD 1
ADD D0,D1 ; ADD TO SAVED NUMBER
MOV D1,D0 ; AND SAVE A COPY
P3: ; CALCULATION PART THREE
DIV D0,#1461. ; DIVIDE D0
AND #177777,D0 ; ELIMINATE REMAINDER
SUB D0,D1 ; SUB FROM SAVED NUMBER
P4: ; CALCULATION PART FOUR
DIV D1,#365. ; DIVIDE BY DAYS IN YEAR
AND #177777,D1 ; ELIMINATE REMAINDER
; D1 = YEAR
;@SP = #OF DAYS ENTERED
MOV D1,D6 ; SAVE YEAR
CALL CALC.D ; CALC # OF DAYS TO 01/00/YEAR
MOV D4,D1 ; SAVE DAYS
; D0 = # OF DAYS FROM 01/01/01 TO 01/00/YEAR
; D1 = # OF DAYS FROM 01/01/01 TO MO/DAY/YEAR
; D4 = " " " " "
; D6 = YEAR
; D7 = 1 FOR LEAP YEAR/ 0 IF NOT
SUB D0,D1 ; CALC DAYS
; D1 = # OF DAYS FROM 01/00/YEAR TO MO/DAY/YEAR
; D6 = YEAR
; D7 = 1 FOR LEAP YEAR/ 0 IF NOT
; DETERMINE MO AND DAY
MOVW #1,D0 ; SET MO POINTER
CLR D2 ; PRE-CLEAR
10$: MOVB EOM[~D0],D2 ; GET DAYS IN MONTH (D0)
CMPW D0,#2 ; IS IF FEBUARY
BNE 15$ ; BR IF NOT
ADDB D7,D2 ; YES ADD D7= LEAP YEAR
15$: CMPW D1,D2 ; CMP DAYS TO DATE TO EOM
BLOS 20$ ; IF LESS WE FOUND IT
SUBW D2,D1 ; SUB DAYS IN MO FROM DAYS TO DATE
INCW D0 ; INC MO POINTER
BR 10$ ; TRY AGAIN
; DATE FOUND PACKIT WITH YEAR
20$:
; D0 = MONTH
; D1 = DAY
; D6 = YEAR
LSLW D1,#8. ; SHIFT LEFT EIGHT BITS
MOVB D0,D1 ; SET LOWER BYTE =MO
; D1.W = MO/DAY
MOV #16.,D2 ; SET COUNTER
ROL D6,D2 ; ROLL LEFT 16 BITS
MOVW D1,D6 ; SET LOW WORD=MO/DAY
ROR D6,D2 ; ROLL RIGHT 16 BITS
JMP FIN ; ALL DONE
; D6 = MO/DAY/YEAR
; PROCESS ERRORS
NO.GOOD: REST D6 ; RET REGISTERS
DATE.NO.GOOD:
LCC #PS.Z ; INDICATE ERROR
FIN: REST D0-D2,A5 ; REST REGISTERS
RTN
; LIST OF DAYS IN MONTH
EOM: BYTE 0,31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
EVEN
$DTO.I: ; ENTER D6= DATE IN SEP FORMAT (NOT AM STANDARD)
SAVE D0-D2,A5 ; SAVE REGISTERS
CMPW D6,#10000. ; YEAR MAX IS 10,000 DECIMAL
BHI DATE.NO.GOOD ; BR IF NO GOOD
CALL CALC.D ; CALC DAYS TO 01/00/YEAR
; D0=NUMBER OF DAYS TO FIRST OF YEAR -1
; D7= LEAP YEAR 1=YES 0=NO
MO.VER: ; VERIFY MONTH
SWAP D6 ; GET MONTH IN LOWER BYTE
CMPB D6,#12. ; CHECK WITH 12 MONTHS
BHI DATE.NO.GOOD ; IF HI NO GOOD
; CALC UP TO MONTH
CLR D2 ; PRE-CLEAR
MOV #1,D1 ; SET MONTH POINTER
10$:
CMPB D1,D6 ; AT MONTH YET
BEQ DAY.VER ; BR IF YES
MOVB EOM[~D1],D2 ; NO GET DAYS IN MONTH PRIOR
ADD D2,D0 ; ADD TO CUMULATIVE
INCB D1 ; INC MO POINTER
BR 10$ ; BR AGAIN
DAY.VER: ; VERIFY DAY GIVEN
ROLW D6,#8. ; ROLL WORD LEFT 8 BITS
CMPB D6,EOM[~D1] ; CMP DAYS IN MO TO PASSED
BHI 20$ ; BR IF HI MAYBE NO GOOD
MOVB D6,D2 ; SET D2=PASSED VALUE
ADD D2,D0 ; ADDIT TO CUMLUATIVE
CMPB D7,#1 ; LEAP YEAR ?
BNE 10$ ; BR IF NOT
CMPB D1,#2 ; PAST FEBUARY
BLOS 10$ ; BR IF NOT
ADD #1,D0 ; INC CUMULATIVE
; ALL DONE
10$:
BR FINISH
; DAYS PAST MAY BE TOO HIGH
20$:
CMPB D1,#2 ; MO PASSED FEBUARY
BNE DATE.NO.GOOD ; BR IF NOT
CMPB D7,#1 ; THIS A LEAP YEAR
BNE DATE.NO.GOOD ; BR IF NOT
CMPB D6,#29. ; ONLY #29 ALLOWED
BNE DATE.NO.GOOD ; BR IF NOT
ADD #29.,D0 ; INC D0 BY 29 DAYS
; ALL DONE
FINISH:
MOV D0,D6 ; RESET D6
ADD #2351425.,D6 ; CORRECT TO AM FORMAT
REST D0-D2,A5 ; REST REGISTERS
RTN ; GO BACK
; CALC DAYS IN YEAR
; D6= YEAR PASSED
CALC.D: CLR D7 ; PRE-CLEAR
CLR D0 ; PRE-CLEAR
DECW D6 ; SUB 1 FROM YEAR PASSED
MOVW D6,D0 ; SAVE IT
MUL D0,#365. ; MUL BY 365 DAYS A YEAR
CLR D1 ; PRE-CLEAR
MOVW D6,D1 ; GET YEAR
DIV D1,#4. ; DIV BY 4 = # OF LEAP YEARS
AND #177777,D1 ; ELIMINATE REMAINDER
ADD D1,D0 ; ADD TO CUMULATIVE
MOVW D6,D1 ; GET YEAR
DIV D1,#100. ; CHECK FOR 100 YEAR EXCEPTIONS
AND #177777,D1 ; ELIMINATE REMAINDER
SUB D1,D0 ; SUB FROM CUMULATIVE
MOVW D6,D1 ; GET YEAR
DIV D1,#400. ; CHECK FOR 400 YEAR EXCEPTIONS
AND #177777,D1 ; ELIMINATE REMAINDER
ADD D1,D0 ; ADD TO CUMULATIVE
LEAP.YEAR: INCW D6 ; RESET TO ORIGINAL YEAR PASSED
CLR D1 ; PRE-CLEAR
MOVW D6,D1 ; GET YEAR
DIV D1,#4. ; DIV BY 4 (PER LEAP YEAR CYCLE)
SWAP D1 ; GET REMAINDER
TSTW D1 ; CHECK FOR ZERO
BNE 30$ ; BR IF NOT
MOVB #1,D7 ; SET LOW BYTE TO 1 - FLAG YES
10$: ; CHECK FOR 100 YEAR EXCEPTION
CLR D1 ; PRE-CLEAR
MOVW D6,D1 ; GET YEAR
DIV D1,#100. ; DIV BY 100 (CYCLE)
SWAP D1 ; GET REMAINDER
TSTW D1 ; IS IT ZERO
BNE 30$ ; BR IF NOT
CLRB D7 ; YES SO UN SET FLAG
20$: ; CHECK FOR 400 YEAR EXCEPTION
CLR D1 ; PRE-CLEAR
MOVW D6,D1 ; GET YEAR
DIV D1,#400. ; DIV BY 400 (CYCLE)
SWAP D1 ; GET REMAINDER
TSTW D1 ; IS IT ZERO
BNE 30$ ; BR IF NOT
MOVB #1,D7 ; YES SET FLAG
30$: RTN ; ALL DONE
;CALC DAY OF WEEK
; D3=DATE AS DAYS
DOW:
MOV D3,D2 ; SAVE DAYS
; ADJUST DAYS DIV HAS MAX LIMIT
DIV D2,#343. ; DIV LARGE NUMBER DIV BY 7
AND #177777,D2 ; ELIMINATE REMAINDER
BEQ 10$ ; CONT IF NO QUO
MUL D2,#343. ; MUST ADJUST CALC D2*343.
SUB D2,D3 ; SUB FROM PASED NUMBER
10$:
DIV D3,#7. ; CALC MODULO 7
SWAP D3 ; GET REMAINDER
AND #177777,D3 ; STRIP QUO
RTN ; D3= DOW
END