.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