.TITLE CLUNK
.IDENT /V1.0/
.SBTTL CONSTANTS AND BUFFERS
;
;			--- AUTHORED BY ---
;
;			BOB ROCK
;			NORTHEAST ELECTRONICS DIV.
;			NORTHERN TELECOM INC.
;			AIRPORT RD.
;			CONCORD, N.H. 03301
;			(603) 224-6511 EXT 347
;
;	FORTRAN CALLABLE ROUTINE TO COVERT TO AND FROM
;	DATATRIEVE CLUNKS AND RSX-11 FORMAT TIME AND DATE
;
;		BY BOB ROCK	APR-81
;
;	LAST EDIT: 10-JUN-1987 20:17:20 
;
;	BASIC PLUS-2
;		CALL C2DATE BY REF (CLUNKS%(),C.DATE$,C.TIME$,STATUS%)
;
;			CLUNKS% IS A 4 WORD INTEGER ARRAY
;			C.DATE$ MUST BE A 9 CHAR MIN. STRING
;			C.TIME$ MUST BE A 8 CHAR MIN. STRING
;			STATUS% RETURNS FOLLOWING RESULTS:
;				1 = SUCCESS
;				-1 = ERROR - DATE WAS PRIOR TO 1900
;				-2 = ERROR - DATE AFTER 1999
;                               -3 = ERROR - CLUNK OVERFLOW
;
;
;  THIS ROUTINE HAS BEEN MODIFIED BY PHILIP HANNAY, CARGILL GRAIN LAB,
;    3444 DIGHT AV S, MINNEAPOLIS, MN. 55407,  (612)-721-8531, FOR
;    OUR USE.  THE MODIFICATIONS ARE ACTUALLY CORRECTIONS, ONE
;    TO DETECT ILLEGAL CHARACTERS IN THE ASCII YEAR INPUT, THE OTHER
;    TO DO CORRECT DECIMAL TO BINARY CONVERSION OF THE MINUTES AND
;    SECONDS OF THE ASCII TIME INPUT.  JULY 6, 1982.  THIS ROUTINE
;    USES THE STANDARD DEC CALL SITE SO IT CAN BE CALLED BY FORTRAN OR
;    BY OMSI PASCAL V2.0 WITH NO CHANGES.
;
;  IT WAS FURTHER MODIFIED BY BOB THOMAS,CARGILL,INC.,P.O. BOX 9300
;    MPLS,MN,55440, (612)475-5432. THOSE FURTHER MODIFICATIONS
;    WERE TO CORRECT THE VALUES FOR 1 SEC, 1 MIN AND 1 HOUR. IN
;    ADDITION THE ADD64 ROUTINE WAS REWRITTEN TO PROVIDE FOR CASCADING 
;    CARRY BITS (SUCH AS THOSE THAT OCCUR ON 05-JUN-86 17:09:27).
;
;
;  PETER STADICK  24-MAY-87 - MODIFIED BY ADDING PROGRAM SEGMENTS. 
;    YOU CAN BUILD THIS INTO I/D SPACE TASKS.
;
.PSECT CLUDAT,RW,D,LCL,REL
; SOME USEFUL CONSTANTS...
;
;	NOTE:
;		FORMAT OF LONG WORDS IS LSW,...,MSW
;  A SECOND - 10,000,000 CLUNKS
;
SEC:  .WORD 113200,000230,000000,000000
;
;  A MINUTE - 600,000,000 CLUNKS
;
MIN:  .WORD 043000,021703,000000,000000
;
;  AN HOUR - 36,000,000,000 CLUNKS
;
HOUR:  .WORD 064000,060704,000010,000000
;
;  A DAY - 864,000,000,000 CLUNKS
;
DAY:	.WORD 140000,025151,000311,000000
;
;  A WEEK - 6,048,000,000,000 CLUNKS
;
WEEK:	.WORD 040000,024344,002600,000000
;
;  28 DAYS - 24,192,000,000,000 CLUNKS
;
DAY28:	.WORD 000000,121621,013000,000000
;
;  29 DAYS - 25,056,000,000,000 CLUNKS
;
DAY29:	.WORD 140000,146772,013311,000000
;
;  30 DAYS - 25,920,000,000,000 CLUNKS
;
DAY30:	.WORD 100000,174144,013622,000000
;
;  31 DAYS - 26,787,000,000,000 CLUNKS
;
DAY31:	.WORD 040000,021316,014134,000000
;
;  NON-LEAP YEAR (365 DAYS) - 306,600,000,000,000 CLUNKS
;
DAY365: .WORD 140000,074306,017321,000001
;
;  LEAP YEAR (366 DAYS) - 307,440,000,000,000 CLUNKS
;
DAY366: .WORD 100000,121460,017632,000001
;
;  OFFSETT FROM 17-NOV-1858 TO 1-JAN-1900
;
OFFSET:	.WORD 000000,072215,015304,000056
;
;  THE ASCII MONTH TABLE
;
ASCMON:	.ASCII /JAN/
	.ASCII /FEB/
	.ASCII /MAR/
	.ASCII /APR/
	.ASCII /MAY/
	.ASCII /JUN/
	.ASCII /JUL/
	.ASCII /AUG/
	.ASCII /SEP/
	.ASCII /OCT/
	.ASCII /NOV/
	.ASCII /DEC/
;
;  DAYS PER MONTH TABLE
;
DAYMON:	.BYTE 31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
;
;  CLUNKS PER MONTH TABLE
;
CLDAY:	.WORD DAY31	; JAN
	.WORD 0		; FEB SET BY APPROPRIATE ROUTINE FOR LEAP YEAR OR NOT
	.WORD DAY31	; MAR
	.WORD DAY30	; APR
	.WORD DAY31	; MAY
	.WORD DAY30	; JUN
	.WORD DAY31	; JUL
	.WORD DAY31	; AUG
	.WORD DAY30	; SEP
	.WORD DAY31	; OCT
	.WORD DAY30	; NOV
	.WORD DAY31	; DEC
;
;  SOME USEFUL INTERMEDIATE STORRAGE LOCATIONS
;
TEMP1:	.WORD 0,0,0,0

TEMP2:	.WORD 0,0,0,0

TEMP3:	.WORD 0,0,0,0

CLUNKS:	.BLKW 4

DATE:	.BLKB 9.	; FORMAT DA-MON-YR
	.BYTE 0
TIME:	.BLKB 8.	; FORMAT HH:MM:SS
	.BYTE 0

	.EVEN
BYEAR:	.WORD 0
BMONTH:	.WORD 0
BDAY:	.WORD 0
BHOUR:	.WORD 0
BMIN:	.WORD 0
BSEC:	.WORD 0

STATUS:	.WORD 0

.SBTTL CONVERT CLUNKS TO SYSTEM DATE AND TIME

.PSECT CLUPGM,RO,I,LCL,REL
C2DATE::
	MOV R5, -(SP)		; SAVE POINTER FOR LATER USE...

	MOV 2(R5),R4		; PICK UP ADDRESS OF CLUNK
	MOV (R4)+,CLUNKS	;  AND MOVE TO BUFFER
	MOV (R4)+,CLUNKS+2	;
	MOV (R4)+,CLUNKS+4
	MOV (R4)+,CLUNKS+6

		; SUBTRACT THE OFFSET FOR REFERENCE TO BASE YEAR (1900)

	MOV #CLUNKS,R0		; (R2) = (R0) - (R1)
	MOV #OFFSET,R1
	MOV #CLUNKS,R2
	JSR PC, SUB64
	BCC 10$			; BRANCH IF YEAR LESS THAN 1900
	MOV #-1, STATUS
	JMP ERR

		; SUBTRACT YEARS UNTIL FOUND

10$:	CLR BYEAR	; YEAR COUNTER = 0
	BR START

COUNTY:
	BIT #3,BYEAR		;DETERMINE IF LEAP YEAR (BITS 0-2 CLEAR)
	BEQ ST1			; BR IF LEAP YEAR

START:	MOV #DAY365,R1
	BR ST2

ST1:	MOV #DAY366,R1

ST2:	MOV #CLUNKS,R0		; SUBTRACT A 365 DAY YEAR
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS CHKYR

	INC BYEAR
	MOV TEMP1,  CLUNKS		; MOVE THE RESULT BACK TO CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR COUNTY

CHKYR:	CMP BYEAR,#100.			;MUST BE DURING THIS CENTURY ONLY...
	BLO COUNTM
	MOV #-2,STATUS
	JMP ERR

		; DETERMINE THE MONTH...

COUNTM:
	MOV #1, BMONTH		; NOTE: JAN IS MONTH 1
	MOV #CLDAY,R3		;  TABLE POINTER

	TST BYEAR		; NOTE -  1900 WAS NOT A LEAP YEAR !
	BEQ 5$
	BIT #3, BYEAR		; IS THIS A LEAP YEAR?
	BEQ 10$			; BR IF YES
5$:	MOV #DAY28,CLDAY+2	;  ELSE SET FOR 28 DAYS
	BR 20$
10$:	MOV #DAY29,CLDAY+2	; LEAP YEAR...

20$:	MOV #CLUNKS,R0
	MOV (R3),   R1		; CLUNKS PER MONTH TABLE
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS COUNTD

	INC BMONTH		;BUMP THE MONTH COUNTER
	INC R3
	INC R3
	MOV TEMP1,  CLUNKS	; AND RETURN THE RESULT TO CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR 20$

		; NOW TAKE CARE OF THE REMAINING DAYS...

COUNTD:

	MOV #1,BDAY		;FIRST DAY OF MONTH IS ALWAYS 1...

10$:	MOV #CLUNKS,R0
	MOV #DAY,   R1
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS COUNTH

	INC BDAY
	MOV TEMP1,  CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR 10$

COUNTH:
	CLR BHOUR		;FIRST HOUR OF DAY IS 00...

10$:	MOV #CLUNKS,R0
	MOV #HOUR,  R1
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS COUNTN

	INC BHOUR
	MOV TEMP1, CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR 10$

		; COUNT THE MINUTES...

COUNTN:
	CLR BMIN		;FIRST MINUTE OF HOUR IS 00..

10$:	MOV #CLUNKS,R0
	MOV #MIN,   R1
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS COUNTS

	INC BMIN
	MOV TEMP1,  CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR 10$

		; COUNT THE SECONDS

COUNTS:
	CLR BSEC

10$:	MOV #CLUNKS,R0
	MOV #SEC,   R1
	MOV #TEMP1, R2
	JSR PC, SUB64
	BCS CONVRT

	INC BSEC
	MOV TEMP1,  CLUNKS
	MOV TEMP1+2,CLUNKS+2
	MOV TEMP1+4,CLUNKS+4
	MOV TEMP1+6,CLUNKS+6
	BR 10$

		; CONVERT THE BINARY NUMBERS TO ASCII STRINGS

CONVRT:
	MOV #DATE,R0		;USE THE SYSTEM LIBRARY FUNCTION
	CMP BDAY,#10.		;WANT TO RIGHT JUSTIFY THIS IF DAY < 10.
	BHIS 5$			;  NONE NEEDED
	MOVB #40,(R0)+		;   PAD WITH SPACE AND SHIFT RIGHT
5$:	MOV #BYEAR,R1
	CALL $DAT

		;CONVERT LAST TWO CHAR OF MONTH TO LOWER CASE...

	BISB #40,DATE+4
	BISB #40,DATE+5

	MOV #TIME,R0		;USE THE SYSTEM LIBRARY FUNCTION
	MOV #BHOUR,R1
	MOV #3,R2		; FORMAT HH:MM:SS
	CALL $TIM

	MOV (SP)+,R5		;GET ARG POINTER BACK FROM STACK

	MOV 4(R5),R0		;GET POINTER TO DATE STRING
	MOV #DATE,R1		;  AND POINTER TO DATE
	MOV #9.,R2		;  USE LENGTH AS COUNTER
10$:	MOVB (R1)+,(R0)+
	SOB R2,10$

	MOV 6(R5),R0		;GET POINTER TO TIME STRING
	MOV #TIME,R1		; LIKE ABOVE
	MOV #8.,R2
20$:	MOVB (R1)+,(R0)+
	SOB R2,20$
	MOV #1, STATUS
	BR GOBACK

ERR:
	MOV (SP)+,R5		;CLEAN UP STACK...

GOBACK:
	MOV STATUS,@10(R5)
	
	RTS PC
.SBTTL CONVERT SYSTEM DATE AND TIME TO CLUNKS

	;
	; CONVERTS SYSTEM DATE AND TIME TO CLUNKS
	;
	;	*** USE THE SAME CALLING SEQUENCE AS C2DATE...
	;
D2CLNK::
		;MAKE A LOCAL COPY OF DATE AND TIME

	MOV R5,-(SP)	; SAVE ARG POINTER FOR LATER USE

	MOV 4(R5),R0
	MOV #DATE,R1
	MOV #9.,  R2
10$:	MOVB (R0)+,(R1)+
	SOB R2, 10$

	MOV 6(R5),R0	;GET POINTER TO TIME STRING
	MOV #TIME,R1
	MOV #8.,  R2
20$:	MOVB (R0)+,(R1)+
	SOB R2, 20$

		;CONVERT DAY TO BINARY

	MOV #DATE,R0
	CALL $CDTB
	MOV R1, BDAY		;R0 = ADDR OF NEXT BYTE
				;R1 = CONVERTED VALUE
				;R2 = TERMINATING CHAR
	TST R1
	BNE 25$			; A ZERO DAY IS NOT PERMITTED
	MOV #-2, STATUS		;  INDICATE ILLEGAL DATE
	JMP ERRD

25$:	CMPB #'-,R2
	BEQ CMON		;NOTE - FORMAT IS DA-MON-YR
30$:	MOV #-1,STATUS
	JMP ERRD

		;CONVERT MONTH TO BINARY

CMON:			; R0 POINTING TO MONTH
	MOV #ASCMON,R1	;POINTER TO ASCII TABLE
	MOV #1,BMONTH	; ACTS AS A MONTH COUNTER

10$:	BICB #40,(R0)	;CONVERT TO UPPER CASE
	CMPB (R0),(R1)	;COMPARE MONTH TO TABLE...
	BNE 20$

	BICB #40,1(R0)
	CMPB 1(R0),1(R1)
	BNE 20$

	BICB #40,2(R0)
	CMPB 2(R0),2(R1)
	BEQ 50$			; A MATCH !!!

20$:	CMP #12.,BMONTH		;12TH MONTH YET?
	BNE 30$
	MOV #-1,STATUS		; YES - FORMAT ERROR
	JMP ERRD

30$:	ADD #3,R1		;POINT TO NEXT MONTH
	INC BMONTH
	BR 10$

50$:	CMPB #'-,3(R0)
	BEQ CYEAR
	MOV #-1,STATUS
	JMP ERRD

		; CONVERT YEARS TO BINARY

CYEAR:	ADD #4,R0
	CALL $CDTB
	MOV R1, BYEAR
;
; ADDED BY PHIL HANNAY TO TEST FOR PREMATURE CONVERSION TERMINATION
;
	CMPB #0,R2		;LOOK AT TERMINATION CHARACTER
	BEQ 2$			;BRANCH IF NULL CHARACTER AT END
	CMPB #32.,R2		;NOT NULL, MAYBE A BLANK
	BNE 3$			;BRANCH IF NOT BLANK CHARACTER AT END
;
; END ADDITION
;
2$:	CMP R1, #100.		;YEARS MUST BE LESS THAN 100.
	BLO CHKDAY
3$:	MOV #-1, STATUS
	JMP ERRD

		; CHECK THAT THE CURRENT DAY CAN EXIST THIS YEAR

CHKDAY:	TST BYEAR		; NOTE THAT 1900 WAS NOT A LEAP YEAR...
	BEQ 5$
	BIT #3, BYEAR		;TEST FOR LEAP YEAR
	BEQ 10$			; BR IF LEAPING

5$:	MOV #DAY28, CLDAY+2	;NOT LEAP YEAR, SET TABLES ACCORDINGLY
	MOVB #28., DAYMON+1
	BR 20$

10$:	MOV #DAY29, CLDAY+2	; THIS IS A LEAP YEAR
	MOVB #29., DAYMON+1

20$:	MOV BMONTH, R0		;NOW TEST THE DAY...
	DEC R0			; JAN IS MONTH ONE...
	MOV BDAY, R1
	CMPB R1, DAYMON(R0)
	BLOS CHOUR
	MOV #-2,STATUS		; ILLGAL DAY FOR MONTH WAS DETECTED
	JMP ERRD

		;CONVERT HOUR TO BINARY

CHOUR:	MOV #TIME,R0
	CALL $CDTB
	MOV R1, BHOUR
	CMP R1, #24.		; MUST BE LESS THAN 24 HOURS...
	BLO 10$
	BR 20$

10$:	CMPB #':,R2		;NOTE FORMAT HH:MM:SS
	BEQ CMIN
20$:	MOV #-1,STATUS
	JMP ERRD

		; CONVER MINUTE TO BINARY

;
; IN ORIGINAL VERSION, AN "INC R0" WAS INCORRECTLY PLACED AT CMIN:,
;  CAUSING NUMBER CONVERSION TO START AT THE CHARACTER FOLLOWING THE
;  ACTUAL "FIRST" CHARACTER OF THE NUMBER.  REMEMBER THAT $CDTB LEAVES
;  R0 POINTING TO THE NEXT BYTE FOLLOWING THE TERMINATION CHARACTER.
;
;  PHIL HANNAY  JULY 6, 1982
;
CMIN:	CALL $CDTB
	MOV R1, BMIN
	CMP R1,#60.		; MUST BE LESS THAN 60 MIN
	BLO 10$
	BR 20$

10$:	CMPB #':,R2
	BEQ CSEC
20$:	MOV #-1,STATUS
	JMP ERRD

		; CONVER SECONDS TO BINARY
;
; IN ORIGINAL VERSION, AN "INC R0" WAS INCORRECTLY PLACED AT CSEC:,
;  CAUSING NUMBER CONVERSION TO START AT THE CHARACTER FOLLOWING THE
;  ACTUAL "FIRST" CHARACTER OF THE NUMBER.  REMEMBER THAT $CDTB LEAVES
;  R0 POINTING TO THE NEXT BYTE FOLLOWING THE TERMINATION CHARACTER.
;
;  PHIL HANNAY  JULY 6, 1982
;
CSEC:	CALL $CDTB
	MOV R1,BSEC
	CMP R1,#60.
	BLO CADD
	MOV #-1,STATUS
	JMP ERRD
	
		; TIME TO CHANGE BINARY INFORMATION TO CLUNKS
		; NOTE - ERROR CHECKING IS BEEN COMPLETED

CADD:

		; CLUNKS = OFFSET + YEARS + LEAP DAYS

	MOV OFFSET,   CLUNKS	; MOVE THE OFFSET
	MOV OFFSET+2, CLUNKS+2
	MOV OFFSET+4, CLUNKS+4
	MOV OFFSET+6, CLUNKS+6

		; ADD ON THE YEARS

	MOV BYEAR, R3		; USE AS YEAR COUNTER
	TST R3			;  WAS IT ZERO (1900)
	BEQ ADDL		;  BR IF YES

10$:	MOV #DAY365, R0
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; ADD IN THE LEAP YEARS

ADDL:	MOV BYEAR, R3		; # LEAP DAYS = (BYEAR/4)-1
	ASH #-2, R3
	BEQ ADDM		; IF NONE - WHY WORRY?
	BIT #3,BYEAR		; IF PRESENT YEAR IS LEAP, THEN WILL DEAL
	BNE 10$			;   WITH IT LATER, ELSE CONTINUE
	DEC R3
	BEQ ADDM

10$:	MOV #DAY,    R0		; ELSE ADD THEM IN...
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; TAKE CARE OF THE DAYS OF THE MONTH

ADDM:
	MOV BMONTH, R3
	CLR R4

50$:	DEC R3			;DO THIS LOOP FOR MONTH-1 TIMES
	BEQ ADDD
	MOV CLDAY(R4),R0	;GET A POINTER TO THE PROPER MONTH
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	INC R4
	INC R4
	BR 50$

		; ADD DAYS-1 TO TOTAL

ADDD:	MOV BDAY, R3
	DEC R3
	BEQ ADDH

10$:	MOV #DAY, R0
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; ADD IN THE HOURS

ADDH:	MOV BHOUR, R3
	TST R3
	BEQ ADDMIN

10$:	MOV #HOUR, R0
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; ADD IN MINUTES

ADDMIN:	MOV BMIN, R3
	TST R3
	BEQ ADDSEC

10$:	MOV #MIN, R0
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; ADD IN SECONDS

ADDSEC:	MOV BSEC, R3
	TST R3
	BEQ DONE

10$:	MOV #SEC, R0
	MOV #CLUNKS, R1
	MOV #CLUNKS, R2
	JSR PC, ADD64
        BCS ERRD
	SOB R3, 10$

		; CLUNK CALCULATION IS NOW COMPLETE
		; RETURN THE CLUNKS TO THE CALLING PROGRAM

DONE:	MOV (SP)+, R5	;GET ARG POINTER BACK FROM STACK

	MOV 2(R5),R0	;GET ADDRESS OF CALLER'S BUFFER

	MOV CLUNKS,    (R0)
	MOV CLUNKS+2, 2(R0)
	MOV CLUNKS+4, 4(R0)
	MOV CLUNKS+6, 6(R0)

	MOV #1, STATUS		; INDICATE SUCCESSFUL STATUS
	BR DONE1

ERRD:	MOV (SP)+, R5		;RESTORE ARG POINTER

DONE1:	MOV STATUS, @10(R5)	;RETURN OUR STATUS TO CALLER
	RTS PC
	

.SBTTL ADD OR SUBTRACT TO CLUNK TIME ROUTINE (A2CLNK)
A2CLNK::
	MOV R5, -(SP)		; SAVE POINTER FOR LATER USE...

	MOV 2(R5),R4		; PICK UP ADDRESS OF CLUNK
	MOV (R4)+,CLUNKS	;  AND MOVE TO BUFFER
	MOV (R4)+,CLUNKS+2	;
	MOV (R4)+,CLUNKS+4
	MOV (R4)+,CLUNKS+6



; ADD OR SUBTRACT DAYS
	MOV 6(R5),R0		; NUMBER OF DAYS TO ADD OR SUBTRACT
	MOV #DAY,R1		; CLUNK SIZE OF DAY
	MOV #TEMP1,R2		; RESULT LOCATION

	JSR PC,M1664		; MULTIPLY TO FIND CLUNKS TO ADD OR SUBTRACT
	BCS AERRD		; IF CARRY SET THEN OVERFLOW

	MOV #TEMP1,R1		; CLUNKS TO ADD OR SUBTRACT
	MOV #CLUNKS,R0		; INPUT CLUNKS
	MOV #TEMP2,R2		; RESULT LOCATION

	TST @4(R5)		; SEE IF WE SHOULD ADD OR SUBTRACT
	BPL 10$			; IF POSITIVE THEN ADD ELSE SUBTRACT
	JSR PC,SUB64		; LETS SUBTRACT
	BCS AERRD
	BR  15$
10$:	JSR PC,ADD64		; LETS ADD
	BCS AERRD

15$:				; TEMP2 NOW HAVE LATEST RESULT



; ADD OR SUBTRACT HOURS
	MOV 10(R5),R0		; NUMBER OF HOURS TO ADD OR SUBTRACT
	MOV #HOUR,R1		; CLUNK SIZE OF HOUR
	MOV #TEMP1,R2		; RESULT LOCATION

	JSR PC,M1664		; MULTIPLY TO FIND CLUNKS TO ADD OR SUBTRACT
	BCS AERRD		; IF CARRY SET THEN OVERFLOW

	MOV #TEMP1,R1		; CLUNKS TO ADD OR SUBTRACT
	MOV #TEMP2,R0		; INPUT CLUNKS
	MOV #CLUNKS,R2		; RESULT LOCATION

	TST @4(R5)		; SEE IF WE SHOULD ADD OR SUBTRACT
	BPL 20$			; IF POSITIVE THEN ADD ELSE SUBTRACT
	JSR PC,SUB64		; LETS SUBTRACT
	BCS AERRD
	BR  25$
20$:	JSR PC,ADD64		; LETS ADD
	BCS AERRD

25$:				; CLUNKS NOW HAVE LATEST RESULT



; ADD OR SUBTRACT MINUTES
	MOV 12(R5),R0		; NUMBER OF MINUTES TO ADD OR SUBTRACT
	MOV #MIN,R1		; CLUNK SIZE OF MINUTE
	MOV #TEMP1,R2		; RESULT LOCATION

	JSR PC,M1664		; MULTIPLY TO FIND CLUNKS TO ADD OR SUBTRACT
	BCS AERRD		; IF CARRY SET THEN OVERFLOW

	MOV #TEMP1,R1		; CLUNKS TO ADD OR SUBTRACT
	MOV #CLUNKS,R0		; INPUT CLUNKS
	MOV #TEMP2,R2		; RESULT LOCATION

	TST @4(R5)		; SEE IF WE SHOULD ADD OR SUBTRACT
	BPL 30$			; IF POSITIVE THEN ADD ELSE SUBTRACT
	JSR PC,SUB64		; LETS SUBTRACT
	BCS AERRD
	BR  35$
30$:	JSR PC,ADD64		; LETS ADD
	BCS AERRD

35$:				; TEMP2 NOW HAVE LATEST RESULT


; ADD OR SUBTRACT SECONDS
	MOV 14(R5),R0		; NUMBER OF SECONDS TO ADD OR SUBTRACT
	MOV #SEC,R1		; CLUNK SIZE OF SECOND
	MOV #TEMP1,R2		; RESULT LOCATION

	JSR PC,M1664		; MULTIPLY TO FIND CLUNKS TO ADD OR SUBTRACT
	BCS AERRD		; IF CARRY SET THEN OVERFLOW

	MOV #TEMP1,R1		; CLUNKS TO ADD OR SUBTRACT
	MOV #TEMP2,R0		; INPUT CLUNKS
	MOV #CLUNKS,R2		; RESULT LOCATION

	TST @4(R5)		; SEE IF WE SHOULD ADD OR SUBTRACT
	BPL 40$			; IF POSITIVE THEN ADD ELSE SUBTRACT
	JSR PC,SUB64		; LETS SUBTRACT
	BCS AERRD
	BR  ADONE
40$:	JSR PC,ADD64		; LETS ADD
	BCS AERRD

				; CLUNKS NOW HAVE LATEST RESULT

ADONE:	MOV (SP)+, R5		;GET ARG POINTER BACK FROM STACK

	MOV 2(R5),R0		;GET ADDRESS OF CALLER'S BUFFER

	MOV CLUNKS,    (R0)
	MOV CLUNKS+2, 2(R0)
	MOV CLUNKS+4, 4(R0)
	MOV CLUNKS+6, 6(R0)

	MOV #1, STATUS		; INDICATE SUCCESSFUL STATUS
	BR ADONE1

AERRD:	MOV (SP)+, R5		;RESTORE ARG POINTER

ADONE1:	MOV STATUS, @16(R5)	;RETURN OUR STATUS TO CALLER
	RTS PC

.SBTTL DETERMINE DIFFERENCE BETWEEN TWO CLUNK DATES (S2CLNK)

S2CLNK::
	MOV R5, -(SP)		; SAVE POINTER FOR LATER USE...

	MOV 2(R5),R0		; PICK UP ADDRESS OF CLUNK
	MOV (R0)+,CLUNKS	;  AND MOVE TO BUFFER
	MOV (R0)+,CLUNKS+2	;
	MOV (R0)+,CLUNKS+4
	MOV (R0)+,CLUNKS+6
 
	MOV 4(R5),R0
	MOV (R0)+,TEMP1
	MOV (R0)+,TEMP1+2
	MOV (R0)+,TEMP1+4
	MOV (R0)+,TEMP1+6

	MOV #CLUNKS,R0
	MOV #TEMP1,R1
	MOV #TEMP2,R2

	MOV #1,@6(R5)		; ASSUME SIGN POSITIVE
	JSR PC, SUB64		; SUBTRACT TO FIND DIFFERENCE 
	BCC S10			; BRANCH IF POSTIVE RESULT

	MOV #-1,@6(R5)		; SET SIGN NEGITIVE

	MOV R0,R3		; SWAP POSTION OF DATES
	MOV R1,R0
	MOV R3,R1

	JSR PC, SUB64		; SUBTRACT AGAIN TO FIND POSITIVE DIFFERENCE
S10:
	MOV R2,R0		; MOVE POINTER OF REMAINDER TO DIVIDEND
	MOV #TEMP1,R2
	MOV #DAY,R1		; DIVISOR IS CLUNKS PER DAY
	MOV #TEMP3,R3		; QUOTIENT BUFFER
	JSR PC, DIV64
	BCS SERRD
	MOV (R3),@10(R5)	; RESULT NUMBER OF DAYS

	MOV R2,R0		; MOVE POINTER OF REMAINDER TO DIVIDEND
	MOV #TEMP2,R2
	MOV #HOUR,R1		; DIVISOR IS CLUNKS PER HOUR
	MOV #TEMP3,R3		; QUOTIENT BUFFER
	JSR PC, DIV64
	BCS SERRD
	MOV (R3),@12(R5)	; RESULT NUMBER OF HOURS

	MOV R2,R0		; MOVE POINTER OF REMAINDER TO DIVIDEND
	MOV #TEMP1,R2
	MOV #MIN,R1		; DIVISOR IS CLUNKS PER MINUTE
	MOV #TEMP3,R3		; QUOTIENT BUFFER
	JSR PC, DIV64
	BCS SERRD
	MOV (R3),@14(R5)	; RESULT NUMBER OF MINUTES

	MOV R2,R0		; MOVE POINTER OF REMAINDER TO DIVIDEND
	MOV #TEMP2,R2
	MOV #SEC,R1		; DIVISOR IS CLUNKS PER SECOND
	MOV #TEMP3,R3		; QUOTIENT BUFFER
	JSR PC, DIV64
	BCS SERRD
	MOV (R3),@16(R5)	; RESULT NUMBER OF MINUTES

	
SDONE:	MOV (SP)+, R5		; GET ARG POINTER BACK FROM STACK
	MOV #1,STATUS		; SET GOOD STATUS
	BR  SDONE1

SERRD:	MOV (SP)+, R5		; RESTORE ARG POINTER

SDONE1:	MOV STATUS, @20(R5)	; RETURN OUR STATUS TO CALLER
	RTS PC

.SBTTL DETERMINE DAY OF WEEK OF CLUNK VALUE (C2WDAY)
; 
; THIS ROUTINE FINDS THE DAY OF THE WEEK A CLUNK TIME APPEARS IN.
; IT IS HELPFUL TO KNOW THAT NOVEMBER 17,1858 WAS A WEDNESDAY.
;
; RETURNED VALUES:
;  MONDAY = 1 THRU SUNDAY = 7
;
C2WDAY::
	MOV R5, -(SP)		; SAVE POINTER FOR LATER USE...

	MOV 2(R5),R0		; PICK UP ADDRESS OF CLUNK
	MOV (R0)+,CLUNKS	;  AND MOVE TO BUFFER
	MOV (R0)+,CLUNKS+2	;
	MOV (R0)+,CLUNKS+4
	MOV (R0)+,CLUNKS+6

	; FIRST DIVIDE CLUNKS BY CLUNK PER WEEK TO FIND REMAINDER

	MOV #CLUNKS,R0		; DIVIDEND CLUNKS
	MOV #WEEK,R1		; NUMBER OF CLUNKS PER WEEK
	MOV #TEMP1,R3		; RESULT IS NUMBER OF WEEKS
	MOV #TEMP2,R2		; REMAINDER IS CLUNKS LEFT IN WEEK
	JSR PC, DIV64		; DIVIDE TO FIND CLUNS LEFT IN WEEK
	BCS WERRD

	; NOW DIVIDE REMAINDER BY CLUNKS PER DAY TO FIND DAY OF WEEK

	MOV R2,R0		; MOVE REMAINDER TO DIVIDEND
	MOV #DAY,R1		; NUMBER OF CLUNKS PER DAY
	MOV #CLUNKS,R2		; REMAINDER BUFFER
	JSR PC, DIV64		; DIVIDE TO FIND DAY OF WEEK
	BCS WERRD

	ADD #3,TEMP1		; ADJUST WENDSENDAY TO THREE
	CMP #7,TEMP1		; CHECK FOR A MONDAY OR TUESDAY
	BPL WDONE		; BRANCH IF WED THRU SUN
	SUB #7,TEMP1		; ADJUST BACK TO 1 OR 2 FOR 8 OR 9

WDONE:	
	MOV (SP)+, R5		; GET ARG POINTER BACK FROM STACK
	MOV TEMP1,@4(R5)	; MOVE RESULT TO PARAMETER LOCATION

	MOV #1,STATUS		; SET GOOD STATUS
	BR  WDONE1

WERRD:	MOV (SP)+, R5		; RESTORE ARG POINTER

WDONE1:	
	MOV STATUS, @6(R5)	; RETURN OUR STATUS TO CALLER
	RTS PC

.SBTTL 64-BIT ADDITION ROUTINE

		; ROUTINE TO ADD 64 BIT NUMBERS
		;
		; R0 AND R1 POINT TO VALUES TO BE ADDED
		; R2 POINTS TO DESTINATION OF SUM
		;
                ; STATUS WILL BE SET TO -3 AND THE CARRY BIT
		; WILL BE SET ON RETURN IF OVERFLOW OCCURS
		;
    		; THIS ROUTINE WAS REWRITTEN BY BOB THOMAS 
                ; ON 21-AUG-86 TO PROVIDE FOR HANDLING CASCADING
                ; CARRY BITS (E.G.  05-JUN-86 17:09:27)
                ;
ADD64:
	MOV (R1),(R2)		;Move the R1 values to R2
	MOV 2(R1),2(R2)	
	MOV 4(R1),4(R2)
	MOV 6(R1),6(R2)

	ADD (R0),(R2)		;Add the first word from R0

	ADC 2(R2)		;Handle any carry bits
        ADC 4(R2)
        ADC 6(R2)
        BCC 10$
        MOV #-3,STATUS		;If carry on the fourth word - error

10$:	ADD 2(R0),2(R2)		;Add the second word from R0

	ADC 4(R2)		;Handle any carry bits
        ADC 6(R2)
        BCC 20$
        MOV #-3,STATUS		;If carry on the fourth word - error

20$:	ADD 4(R0),4(R2)		;Add the third word from R0

	ADC 6(R2)		;Handle any carry bits
        BCC 30$
        MOV #-3,STATUS		;If carry on the fourth word - error

30$:	ADD 6(R0),6(R2)		;Add the fourth word from R0

        BCC 40$
        MOV #-3,STATUS		;If carry on the fourth word - error

40$:	RTS PC			;Return


.SBTTL 64-BIT SUBTRACTION ROUTINE

		; ROUTINE TO SUBTRACT 64 BIT NUMBERS
		;
		; (R0) -(R1) = (R2)
		;
		; CARRY BIT SET ON RETURN INDICATES UNDEFLOW
		;
.PSECT SUB64D,RW,D,LCL,REL
CSTAT:	.WORD 0

.PSECT SUB64I,RO,I,LCL,REL
SUB64:
	MOV (R0),(R2)
	SUB (R1),(R2)

10$:	MOV 2(R0),2(R2)
	SBC 2(R2)
	BCC 12$			;SAVE CARRY STATUS...
	BIS #1,CSTAT		; RECORD CARRY SET
	BR 14$
12$:	BIC #1,CSTAT		; RECORD CARRY CLEAR
14$:	SUB 2(R1),2(R2)
	BCS 20$			; IF CARRY SET, NO NEED TO CHECK PRIOR STATUS
	TST CSTAT		;  OTHERWISE EXIT WITH PREVIOUS CONDITION
	BEQ 20$
	SEC			;   SET C BIT IF SET PREVIOUSLY

20$:	MOV 4(R0),4(R2)
	SBC 4(R2)
	BCC 22$
	BIS #1,CSTAT
	BR 24$
22$:	BIC #1,CSTAT
24$:	SUB 4(R1),4(R2)
	BCS 30$
	TST CSTAT
	BEQ 30$
	SEC

30$:	MOV 6(R0),6(R2)
	SBC 6(R2)
	BCC 32$
	BIS #1,CSTAT
	BR 34$
32$:	BIC #1,CSTAT	
34$:	SUB 6(R1),6(R2)
	BCS 40$
	TST CSTAT
	BEQ 40$
	SEC

40$:	RTS PC


.SBTTL 16-BIT BY 64-BIT MULTIPLICATION ROUTINE

		; ROUTINE TO MULTIPLY A 16 BIT NUMBER BY A 64 BIT NUMBER AND
		; RETURN A 64 BIT RESULT.
		;
		; (R0) * (R1) = (R2)
		;
		; (R0) IS A 16 BIT VALUE
		; (R1) AND (R2) ARE 64 BIT VALUES
		;
		; CARRY BIT SET ON RETURN INDICATES OVERFLOW
		;
M1664:
	MOV R3, -(SP)		; PRESERVE R3 AND R4
	MOV R4, -(SP)

	CLR 4(R2)		; CLEAR TOP PART OF RESULT LOCATION
	CLR 6(R2)

	MOV R0,R3		; MOVE SOURCE ADDRESSES TO R3 AND R4 BECAUSE
	MOV R1,R4		; $MUL USES R0 AND R1

	MOV (R3),R0		; SET UP FOR LOWEST WORD MULTIPLY
	MOV (R4),R1
	CALL $MUL		; USE SYSLIB MULTIPLY ROUTINE
	MOV R1,(R2)		; MOVE LOW WORD RO RESULT LOCATION
	MOV R0,2(R2)		; MOVE HIGH WORD

	MOV (R3),R0		; SET UP FOR SECOND WORD MULTIPLY
	MOV 2(R4),R1
	CALL $MUL
	ADD R1,2(R2)		; ADD HIGH WORD TO SECOND WORD RESULT
	ADC 4(R2)		; IF CARRY ADD TO THIRD WORD RESULT
	ADD R0,4(R2)		; ADD HIGH WORD TO THIRD WORD RESULT
	ADC 6(R2)		; IF CARRY ADD TO FOURTH WORD RESULT

	MOV (R3),R0		; SET UP FOR THIRD WORD MULTIPLY
	MOV 4(R4),R1
	CALL $MUL
	ADD R1,4(R2)		; ADD LOW WORD TO THIRD WORD RESULT
	ADC 6(R2)		; IF CARRY ADD TO FOURTH WORD RESULT
	ADD R0,6(R2)		; ADD HIGH WORD TO FOURTH WORD RESULT
	BCS 40$			; IF CARRY THEN OVERFLOW ERROR

	MOV (R3),R0		; SET UP FOR FOURTH WORD MULTIPLY
	MOV 6(R4),R1
	CALL $MUL
	ADD R1,6(R2)		; ADD LOW WORD TO FOURTH WORD RESULT
	BCS 40$			; IF CARRY THEN OVERFLOW ERROR
	TST R0			; CHECK HIGH WORD OF RESULT
	BEQ 50$			; IF HIGH WORD ZERO THEN ALL OKAY
        SEC

40$:	MOV #-3,STATUS		; OVERFLOW CONDITION PRESENT

50$:	MOV (SP)+,R4		; RESTORE R3 AND R4
	MOV (SP)+,R3

	RTS PC

.SBTTL 64-BIT BY 64-BIT DIVISION ROUTINE

		; ROUTINE TO DIVIDE A 64 BIT NUMBER BY A 64 BIT NUMBER AND
		; RETURN A 64 BIT RESULT AND 64 BIT REMAINDER
		;
		; (R0) / (R1) = (R3) R (R2)
		;
		; CARRY BIT SET ON RETURN INDICATES OVERFLOW
		;
		;  REGISTER USAGE AFTER THIS POINT
		; (R0) = DIVIDEND
		; (R1) = DIVISOR
		; (R2) = REMAINDER
		; (R3) = QUOTIENT
		;  R4  = DIVIDEND SHIFT COUNT
		; (R5) = DIVISOR BIT SET BUFFER

.PSECT DIV64I,RO,I,LCL,REL
DIV64:
	MOV R4, -(SP)		; PRESERVE R4 AND R5
	MOV R5, -(SP)

	TST (R0)		; CHECK FOR ZERO DIVIDEND
	BNE D10
	TST 2(R0)
	BNE D10
	TST 4(R0)
	BNE D10
	TST 6(R0)
	BNE D10
	
	CLR (R3)		; DIVIDEND IS ZERO SO RESULT IS ZERO AND
	CLR 2(R3)		
	CLR 4(R3)
	CLR 6(R3)
	CLR (R2)		; REMAINDER IS ZERO AS WELL
	CLR 2(R2)
	CLR 4(R2)
	CLR 6(R2)

	MOV #1,STATUS		; ALL DONE SO EXIT WITH GOOD STATUS
	CLC
	JMP D99

D10:	TST (R1)		; TEST FOR DIVIDE BY ZERO
	BNE D20
	TST 2(R1)
	BNE D20
	TST 4(R1)
	BNE D20
	TST 6(R1)
        BNE D20			; IF ZERO EXIT WITH OVERFLOW STATUS

	MOV #-3,STATUS		; OVERFLOW CONDITION PRESENT
	SEC
	JMP D99

D20:
	MOV (R0),-(SP)		; PRESERVE DIVIDEND
	MOV 2(R0),-(SP)
	MOV 4(R0),-(SP)
	MOV 6(R0),-(SP)

	MOV (R1),-(SP)		; PRESERVE DIVISOR
	MOV 2(R1),-(SP)
	MOV 4(R1),-(SP)
	MOV 6(R1),-(SP)

	CLR (R3)		; CLEAR QUOTIENT
	CLR 2(R3)
	CLR 4(R3)
	CLR 6(R3)

	CLR R4			; DIVIDEND SHIFT COUNTER

	MOV #0,-(SP)		; QUOTIENT SET WORD STORAGE ON STACK
	MOV #0,-(SP)
	MOV #0,-(SP)
	MOV #1,-(SP)
	MOV SP,R5		; QUOITENT SET WORD LOCATION ON STACK

; ALL SET TO START DIVIDE LOOP OPERATION
	
D40:	

	; SHIFT DIVISOR INTO LEFT MOST PART OF BUFFER

	TST 6(R1)		; CHECK IF ALREADY IN LEFT MOST PART
	BMI D50

D41:	ASL (R5)		; SHIFT BIT SET WORD
	ROL 2(R5)
	ROL 4(R5)
	ROL 6(R5)

	ASL (R1)		; SHIFT DIVISOR
	ROL 2(R1)
	ROL 4(R1)
	ROL 6(R1)
	
	BPL D41
	
D50:	

	; SHIFT DIVIDEND TO THE LEFT MOST PART OF BUFFER
	; COMPENSATE QUOITENT BIT SET IN PROCESS

	TST 6(R0)		; CHECK IF ALREADY IN LEFT MOST PART
	BMI D60

D51:	CLC			; CLEAR CARRY
	ROR 6(R5)		; COMPENSATE QUOITENT BIT SET
	ROR 4(R5)
	ROR 2(R5)
	ROR (R5)
	BCS D80			; ALL DONE WITH DIVISION, SHIFTED QUOITENT
				; BIT SET UNDER ONE

	INC R4			; DIVIDEND SHIFT COUNT

	ASL (R0)		; SHIFT DIVIDEND LEFT
	ROL 2(R0)
	ROL 4(R0)
	ROL 6(R0)

	BPL D51

D60:	JSR PC,SUB64		; TEST SUBTRACT TO CHECK FOR SIGN CHANGE
	BCC D70			; BRANCH IF NO SIGN CHANGE

	; SUBTRACTION RESULT NEGITIVE SO DIVIDE DIVISOR BY 2 AND TRY AGAIN

	CLC			; ADJUST DIVISOR
	ROR 6(R1)
	ROR 4(R1)
	ROR 2(R1)
	ROR (R1)

	CLC			; ADJUST QUOITENT BIT SET
	ROR 6(R5)
	ROR 4(R5)
	ROR 2(R5)
	ROR (R5)

	BCS D80			; ALL DONE WITH DIVISION, SHIFTED QUOITENT
				; BIT SET UNDER ONE

	BR D60

D70:	; SUBTRACTION POSITIVE

	BIS (R5),(R3)		; SET BIT IN QUOITENT
	BIS 2(R5),2(R3)
	BIS 4(R5),4(R3)
	BIS 6(R5),6(R3)

	MOV (R2),(R0)		; MOVE RESULT OF SUBTRACTION TO NEW DIVIDEND
	MOV 2(R2),2(R0)
	MOV 4(R2),4(R0)
	MOV 6(R2),6(R0)

	TST (R0)		; CHECK THAT DIVIDEND IS NOT ZERO
	BNE D40
	TST 2(R0)
	BNE D40
	TST 4(R0)
	BNE D40
	TST 6(R0)
	BNE D40

D80:	; ALL DONE. JUST CLEAN SOME STUFF UP NOW

	MOV (R0),(R2)		; MOVE DIVIDEND TO REMAINDER
	MOV 2(R0),2(R2)
	MOV 4(R0),4(R2)
	MOV 6(R0),6(R2)

	TST R4
	BEQ D89

D88:	CLC			; ADJUST REMAINDER BACK TO RIGHT
	ROR 6(R2)
	ROR 4(R2)
	ROR 2(R2)
	ROR (R2)
	SOB R4,D88

D89:	MOV #1,STATUS		; SET GOOD STATUS	
	CLC

	MOV (SP)+,R5		; CLEAN UP QUOITENT SET BUFFER ON STACK
	MOV (SP)+,R5
	MOV (SP)+,R5
	MOV (SP)+,R5

	MOV (SP)+,6(R1)		; RESTORE DIVISOR
	MOV (SP)+,4(R1)
	MOV (SP)+,2(R1)
	MOV (SP)+,(R1)

	MOV (SP)+,6(R0)		; RESTORE DIVIDEND
	MOV (SP)+,4(R0)
	MOV (SP)+,2(R0)
	MOV (SP)+,(R0)

D99:
	MOV (SP)+,R5		; RESTORE R5
	MOV (SP)+,R4		; RESTORE R4

	RTS PC

	.END