; julian and calendar date functions

month equ F130
day equ F131
year equ F132
jdate equ F133
a equ F134
b equ F135
c equ F136
d equ F137
ee equ F138
y equ F139
z equ F140
m equ F141
jd equ F142
fday equ F143
alpha equ F144

; function prototypes

julian func 1
gdate func 2

#function julian

; Julian date

; Input

; month = calendar month [1 - 12]
; day = calendar day [1 - 31]
; year = calendar year [yyyy]

; Output

; jdate = Julian date

; special notes

; (1) calendar year must include all digits

; (2) will report October 5, 1582 to October 14, 1582
; as invalid calendar dates and set jdate = 0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

y = year

m = month

b = 0.0

c = 0.0

if (m <= 2.0) then
y = y - 1
m = m + 12
endif

if (y < 0.0) then
c = -0.75
endif

; check for valid calendar date

if (year < 1582) then
; null
elseif (year > 1582) then
a = floor(y / 100)
b = 2 - a + floor(a / 4)
elseif (month < 10) then
; null
elseif (month > 10) then
a = floor(y / 100)
b = 2 - a + floor(a / 4)
elseif (day <= 4) then
; null
elseif (day > 14) then
a = floor(y / 100)
b = 2 - a + floor(a / 4)
else

; this is an invalid calendar date

jdate = 0

return

endif

jd = floor(365.25 * y + c) + floor(30.6001 * (m + 1))

jdate = jd + day + b + 1720994.5


#function gdate

; convert Julian date to Gregorian (calendar) date

; input

; jdate = julian day

; output

; month = calendar month [1 - 12]
; day = calendar day [1 - 31]
; year = calendar year [yyyy]

; note: day may include fractional part

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

jd = jdate

z = floor(jd + 0.5)

fday = jd + 0.5 - z

if (fday < 0) then
fday = fday + 1
z = z - 1
endif

if (z < 2299161) then
a = z
else
alpha = floor((z - 1867216.25) / 36524.25)
a = z + 1 + alpha - floor(alpha / 4)
endif

b = a + 1524

c = floor((b - 122.1) / 365.25)

d = floor(365.25 * c)

ee = floor((b - d) / 30.6001)

day = b - d - floor(30.6001 * ee) + fday

if (e < 14) then
month = ee - 1
else
month = ee - 13
endif

if (month > 2) then
year = c - 4716
else
year = c - 4715
endif

' test_dates.bs2

' April 29, 2015

'{$STAMP BS2}
'{$PBASIC 2.5}

'=========================
' uM-FPU64 SPI definitions
'=========================

' BASIC Stamp FPU64
' =========== =====
FpuClk PIN 15 ' SPI clock (connects to SCLK/SCL; 16)
FpuOut PIN 14 ' SPI data out (connects to SIN/SDA; 17)
FpuIn PIN 13 ' SPI data in (connects to SOUT; 18)

'=================
' uM-FPU64 opcodes
'=================

NOP CON $00 ' No Operation
SELECTA CON $01 ' Select register A
SELECTX CON $02 ' Select register X
CLR CON $03 ' reg[nn]=0
CLRA CON $04 ' reg[A]=0
CLRX CON $05 ' reg[X]=0, X=X+1
CLR0 CON $06 ' reg[0]=0 (32-bit), reg[128]=0 (64-bit)
COPY CON $07 ' reg[nn] = reg[mm]
COPYA CON $08 ' reg[nn] = reg[A]
COPYX CON $09 ' reg[nn] = reg[X], X = X + 1
LOAD CON $0A ' reg[0] = reg[nn]
LOADA CON $0B ' reg[0] = reg[A]
LOADX CON $0C ' reg[0] = reg[X], X = X + 1
ALOADX CON $0D ' reg[A] = reg[X], X = X + 1
XSAVE CON $0E ' reg[X] = reg[nn], X = X + 1
XSAVEA CON $0F ' reg[X] = reg[A], X = X + 1
COPY0 CON $10 ' reg[nn] = reg[0]
LCOPYI CON $11 ' reg[nn] = long(signed bb)
SWAP CON $12 ' Swap reg[nn] and reg[mm]
SWAPA CON $13 ' Swap reg[A] and reg[nn]
LEFT CON $14 ' Left parenthesis
RIGHT CON $15 ' Right parenthesis
FWRITE CON $16 ' Write 32-bit float to reg[nn]
FWRITEA CON $17 ' Write 32-bit float to reg[A]
FWRITEX CON $18 ' Write 32-bit float to reg[X], X = X + 1
FWRITE0 CON $19 ' Write 32-bit float to reg[0]
FREAD CON $1A ' Read 32-bit float from reg[nn]
FREADA CON $1B ' Read 32-bit float from reg[A]
FREADX CON $1C ' Read 32-bit float from reg[X], X = X + 1
FREAD0 CON $1D ' Read 32-bit float from reg[0]
ATOF CON $1E ' Convert ASCII to float, store in reg[0]
FTOA CON $1F ' Convert float to ASCII
FSET CON $20 ' reg[A] = reg[nn]
FADD CON $21 ' reg[A] = reg[A] + reg[nn]
FSUB CON $22 ' reg[A] = reg[A] - reg[nn]
FSUBR CON $23 ' reg[A] = reg[nn] - reg[A]
FMUL CON $24 ' reg[A] = reg[A] * reg[nn]
FDIV CON $25 ' reg[A] = reg[A] / reg[nn]
FDIVR CON $26 ' reg[A] = reg[nn] / reg[A]
FPOW CON $27 ' reg[A] = reg[A] ** reg[nn]
FCMP CON $28 ' Float compare reg[A] - reg[nn]
FSET0 CON $29 ' reg[A] = reg[0]
FADD0 CON $2A ' reg[A] = reg[A] + reg[0]
FSUB0 CON $2B ' reg[A] = reg[A] - reg[0]
FSUBR0 CON $2C ' reg[A] = reg[0] - reg[A]
FMUL0 CON $2D ' reg[A] = reg[A] * reg[0]
FDIV0 CON $2E ' reg[A] = reg[A] / reg[0]
FDIVR0 CON $2F ' reg[A] = reg[0] / reg[A]
FPOW0 CON $30 ' reg[A] = reg[A] ** reg[0]
FCMP0 CON $31 ' Float compare reg[A] - reg[0]
FSETI CON $32 ' reg[A] = float(bb)
FADDI CON $33 ' reg[A] = reg[A] + float(bb)
FSUBI CON $34 ' reg[A] = reg[A] - float(bb)
FSUBRI CON $35 ' reg[A] = float(bb) - reg[A]
FMULI CON $36 ' reg[A] = reg[A] * float(bb)
FDIVI CON $37 ' reg[A] = reg[A] / float(bb)
FDIVRI CON $38 ' reg[A] = float(bb) / reg[A]
FPOWI CON $39 ' reg[A] = reg[A] ** bb
FCMPI CON $3A ' Float compare reg[A] - float(bb)
FSTATUS CON $3B ' Float status of reg[nn]
FSTATUSA CON $3C ' Float status of reg[A]
FCMP2 CON $3D ' Float compare reg[nn] - reg[mm]
FNEG CON $3E ' reg[A] = -reg[A]
FABS CON $3F ' reg[A] = | reg[A] |
FINV CON $40 ' reg[A] = 1 / reg[A]
SQRT CON $41 ' reg[A] = sqrt(reg[A])
ROOT CON $42 ' reg[A] = root(reg[A], reg[nn])
LOG CON $43 ' reg[A] = log(reg[A])
LOG10 CON $44 ' reg[A] = log10(reg[A])
EXP CON $45 ' reg[A] = exp(reg[A])
EXP10 CON $46 ' reg[A] = exp10(reg[A])
FSIN CON $47 ' reg[A] = sin(reg[A])
FCOS CON $48 ' reg[A] = cos(reg[A])
FTAN CON $49 ' reg[A] = tan(reg[A])
ASIN CON $4A ' reg[A] = asin(reg[A])
ACOS CON $4B ' reg[A] = acos(reg[A])
ATAN CON $4C ' reg[A] = atan(reg[A])
ATAN2 CON $4D ' reg[A] = atan2(reg[A], reg[nn])
DEGREES CON $4E ' reg[A] = degrees(reg[A])
RADIANS CON $4F ' reg[A] = radians(reg[A])
FMOD CON $50 ' reg[A] = reg[A] MOD reg[nn]
FLOOR CON $51 ' reg[A] = floor(reg[A])
CEIL CON $52 ' reg[A] = ceil(reg[A])
ROUND CON $53 ' reg[A] = round(reg[A])
FMIN CON $54 ' reg[A] = min(reg[A], reg[nn])
FMAX CON $55 ' reg[A] = max(reg[A], reg[nn])
FCNV CON $56 ' reg[A] = conversion(nn, reg[A])
FMAC CON $57 ' reg[A] = reg[A] + (reg[nn] * reg[mm])
FMSC CON $58 ' reg[A] = reg[A] - (reg[nn] * reg[mm])
LOADBYTE CON $59 ' reg[0] = float(signed bb)
LOADUBYTE CON $5A ' reg[0] = float(unsigned byte)
LOADWORD CON $5B ' reg[0] = float(signed word)
LOADUWORD CON $5C ' reg[0] = float(unsigned word)
LOADE CON $5D ' reg[0] = 2.7182818
LOADPI CON $5E ' reg[0] = 3.1415927
FCOPYI CON $5F ' reg[nn] = float(signed bb)
FLOAT CON $60 ' reg[A] = float(reg[A])
FIX CON $61 ' reg[A] = fix(reg[A])
FIXR CON $62 ' reg[A] = fix(round(reg[A]))
FRAC CON $63 ' reg[A] = fraction(reg[A])
FSPLIT CON $64 ' reg[A] = int(reg[A]), reg[0] = frac(reg[A])
SELECTMA CON $65 ' Select matrix A
SELECTMB CON $66 ' Select matrix B
SELECTMC CON $67 ' Select matrix C
LOADMA CON $68 ' reg[0] = matrix A[bb, bb]
LOADMB CON $69 ' reg[0] = matrix B[bb, bb]
LOADMC CON $6A ' reg[0] = matrix C[bb, bb]
SAVEMA CON $6B ' matrix A[bb, bb] = reg[A]
SAVEMB CON $6C ' matrix B[bb, bb] = reg[A]
SAVEMC CON $6D ' matrix C[bb, bb] = reg[A]
MOP CON $6E ' matrix operation
FFT CON $6F ' FFT operation
WRIND CON $70 ' write to indirect pointer
RDIND CON $71 ' read from indirect pointer
DWRITE CON $72 ' write 64-bit value
DREAD CON $73 ' read 64-bit value
LBIT CON $74 ' bit clear/set/toggle/test
SETIND CON $77 ' set indirect pointer value
ADDIND CON $78 ' add to indirect pointer value
COPYIND CON $79 ' copy from indirect pointer to indirect pointer
LOADIND CON $7A ' load reg[0] from indirect pointer
SAVEIND CON $7B ' save reg[A] to indirect pointer
INDA CON $7C ' Select A using value in reg[nn]
INDX CON $7D ' Select X using value in reg[nn]
FCALL CON $7E ' Call user-defined function in Flash memory
EVENT CON $7F ' Background events
RET CON $80 ' Return from user-defined function
BRA CON $81 ' Unconditional branch
BRACC CON $82 ' Conditional branch
JMP CON $83 ' Unconditional jump
JMPCC CON $84 ' Conditional jump
TABLE CON $85 ' Table lookup
FTABLE CON $86 ' Floating point reverse table lookup
LTABLE CON $87 ' Long integer reverse table lookup
POLY CON $88 ' reg[A] = nth order polynomial
FGOTO CON $89 ' Computed goto
RETCC CON $8A ' Conditional return from user-defined function
LWRITE CON $90 ' Write 32-bit long integer to reg[nn]
LWRITEA CON $91 ' Write 32-bit long integer to reg[A]
LWRITEX CON $92 ' Write 32-bit long integer to reg[X], X = X + 1
LWRITE0 CON $93 ' Write 32-bit long integer to reg[0]
LREAD CON $94 ' Read 32-bit long integer from reg[nn]
LREADA CON $95 ' Read 32-bit long integer from reg[A]
LREADX CON $96 ' Read 32-bit long integer from reg[X], X = X + 1
LREAD0 CON $97 ' Read 32-bit long integer from reg[0]
LREADBYTE CON $98 ' Read lower 8 bits of reg[A]
LREADWORD CON $99 ' Read lower 16 bits reg[A]
ATOL CON $9A ' Convert ASCII to long integer
LTOA CON $9B ' Convert long integer to ASCII
LSET CON $9C ' reg[A] = reg[nn]
LADD CON $9D ' reg[A] = reg[A] + reg[nn]
LSUB CON $9E ' reg[A] = reg[A] - reg[nn]
LMUL CON $9F ' reg[A] = reg[A] * reg[nn]
LDIV CON $A0 ' reg[A] = reg[A] / reg[nn]
LCMP CON $A1 ' Signed long compare reg[A] - reg[nn]
LUDIV CON $A2 ' reg[A] = reg[A] / reg[nn]
LUCMP CON $A3 ' Unsigned long compare reg[A] - reg[nn]
LTST CON $A4 ' Long integer status of reg[A] AND reg[nn]
LSET0 CON $A5 ' reg[A] = reg[0]
LADD0 CON $A6 ' reg[A] = reg[A] + reg[0]
LSUB0 CON $A7 ' reg[A] = reg[A] - reg[0]
LMUL0 CON $A8 ' reg[A] = reg[A] * reg[0]
LDIV0 CON $A9 ' reg[A] = reg[A] / reg[0]
LCMP0 CON $AA ' Signed long compare reg[A] - reg[0]
LUDIV0 CON $AB ' reg[A] = reg[A] / reg[0]
LUCMP0 CON $AC ' Unsigned long compare reg[A] - reg[0]
LTST0 CON $AD ' Long integer status of reg[A] AND reg[0]
LSETI CON $AE ' reg[A] = long(bb)
LADDI CON $AF ' reg[A] = reg[A] + long(bb)
LSUBI CON $B0 ' reg[A] = reg[A] - long(bb)
LMULI CON $B1 ' reg[A] = reg[A] * long(bb)
LDIVI CON $B2 ' reg[A] = reg[A] / long(bb)
LCMPI CON $B3 ' Signed long compare reg[A] - long(bb)
LUDIVI CON $B4 ' reg[A] = reg[A] / unsigned long(bb)
LUCMPI CON $B5 ' Unsigned long compare reg[A] - ulong(bb)
LTSTI CON $B6 ' Long integer status of reg[A] AND ulong(bb)
LSTATUS CON $B7 ' Long integer status of reg[nn]
LSTATUSA CON $B8 ' Long integer status of reg[A]
LCMP2 CON $B9 ' Signed long compare reg[nn] - reg[mm]
LUCMP2 CON $BA ' Unsigned long compare reg[nn] - reg[mm]
LNEG CON $BB ' reg[A] = -reg[A]
LABS CON $BC ' reg[A] = | reg[A] |
LINC CON $BD ' reg[nn] = reg[nn] + 1
LDEC CON $BE ' reg[nn] = reg[nn] - 1
LNOT CON $BF ' reg[A] = NOT reg[A]
LAND CON $C0 ' reg[A] = reg[A] AND reg[nn]
LOR CON $C1 ' reg[A] = reg[A] OR reg[nn]
LXOR CON $C2 ' reg[A] = reg[A] XOR reg[nn]
LSHIFT CON $C3 ' reg[A] = reg[A] shift reg[nn]
LMIN CON $C4 ' reg[A] = min(reg[A], reg[nn])
LMAX CON $C5 ' reg[A] = max(reg[A], reg[nn])
LONGBYTE CON $C6 ' reg[0] = long(signed byte bb)
LONGUBYTE CON $C7 ' reg[0] = long(unsigned byte bb)
LONGWORD CON $C8 ' reg[0] = long(signed word wwww)
LONGUWORD CON $C9 ' reg[0] = long(unsigned word wwww)
LSHIFTI CON $CA ' reg[A] = reg[A] shift long(bb)
LANDI CON $C0 ' reg[A] = reg[A] AND ulong(bb)
LORI CON $C1 ' reg[A] = reg[A] OR ulong(bb)
SETSTATUS CON $CD ' set status
FSEROUT CON $CE ' serial output
FSERIN CON $CF ' serial input
DIGIO CON $D0 ' digital I/O
ADCMODE CON $D1 ' Set A/D trigger mode
ADCTRIG CON $D2 ' A/D manual trigger
ADCSCALE CON $D3 ' ADCscale[ch] = B
ADCLONG CON $D4 ' reg[0] = ADCvalue[ch]
ADCLOAD CON $D5 ' reg[0] = float(ADCvalue[ch]) * ADCscale[ch]
ADCWAIT CON $D6 ' wait for next A/D sample
TIMESET CON $D7 ' time = reg[0]
TIMELONG CON $D8 ' reg[0] = time (long)
TICKLONG CON $D9 ' reg[0] = ticks (long)
DEVIO CON $DA ' device I/O
DELAY CON $DB ' delay (milliseconds)
RTC CON $DC ' Real-time clock
SETARGS CON $DD ' set load FCALL argument mode
EXTSET CON $E0 ' external input count = reg[0]
EXTLONG CON $E1 ' reg[0] = external input counter (long)
EXTWAIT CON $E2 ' wait for next external input
STRSET CON $E3 ' Copy string to string buffer
STRSEL CON $E4 ' Set selection point
STRINS CON $E5 ' Insert string at selection point
STRCMP CON $E6 ' Compare string with string buffer
STRFIND CON $E7 ' Find string and set selection point
STRFCHR CON $E8 ' Set field separators
STRFIELD CON $E9 ' Find field and set selection point
STRTOF CON $EA ' Convert string selection to float
STRTOL CON $EB ' Convert string selection to long
READSEL CON $EC ' Read string selection
STRBYTE CON $ED ' Insert byte at selection point
STRINC CON $EE ' Increment string selection point
STRDEC CON $EF ' Decrement string selection point
SYNC CON $F0 ' Get synchronization byte
READSTATUS CON $F1 ' Read status byte
READSTR CON $F2 ' Read string from string buffer
VERSION CON $F3 ' Copy version string to string buffer
IEEEMODE CON $F4 ' Set IEEE mode (default)
PICMODE CON $F5 ' Set PIC mode
CHECKSUM CON $F6 ' Calculate checksum for uM-FPU code
BREAK CON $F7 ' Debug breakpoint
TRACEOFF CON $F8 ' Turn debug trace off
TRACEON CON $F9 ' Turn debug trace on
TRACESTR CON $FA ' Send string to debug trace buffer
TRACEREG CON $FB ' Send register value to trace buffer
READVAR CON $FC ' Read internal variable, store in reg[0]
SETREAD CON $FD ' Set read mode

SyncChar CON $5C ' Sync character

'=================
' uM-FPU variables
'=================

dataWord VAR Word ' data word
dataHigh VAR dataWord.HIGHBYTE ' high byte of dataWord
dataLow VAR dataword.LOWBYTE ' low byte of dataLow
dataByte VAR dataLow ' (alternate name)
opcode VAR dataHigh ' opcode (same as dataHigh)
format VAR dataLow ' format (same as dataLow)
status VAR dataLow ' status (same as dataLow)

status_Zero VAR status.BIT0 ' Zero status bit (0-not zero, 1-zero)
status_Sign VAR status.BIT1 ' Sign status bit (0-positive, 1-negative)
status_NaN VAR status.BIT2 ' Not a Number status bit (0-valid number, 1-NaN)
status_Inf VAR status.BIT3 ' Infinity status bit (0-not infinite, 1-infinite)

'============================
' uM-FPU register definitions
'============================

month CON 130 ' calendar month
day CON 131 ' calendar day
year CON 132 ' calendar year
jdate CON 133 ' julian date

'============================
' uM-FPU function definitions
'============================

julian CON 1 ' uM-FPU user function 1
gdate CON 2 ' uM-FPU user function 2

'===============
' initialization
'===============

Reset:

DEBUG CR, "Julian and Calendar Date Example"

DEBUG CR, "--------------------------------", CR

DEBUG CR

'-----------------------------------
' Reset the uM-FPU and print version
'-----------------------------------

GOSUB Fpu_Reset

IF (status <> SyncChar) THEN

DEBUG "uM-FPU not detected"

END

ELSE

' display the uM-FPU version number

GOSUB Print_Version

DEBUG CR

ENDIF

'=============
' main routine
'=============

Main:

' load calendar date

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [SELECTA, month, ATOF, "4.0", 0, FSET0]

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [SELECTA, day, ATOF, "16.3754895", 0, FSET0]

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [SELECTA, year, ATOF, "2015.0", 0 , FSET0]

' compute julian date

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [FCALL, julian, SELECTA, jdate]

DEBUG CR, "Julian Date "

GOSUB Print_Float

' compute calendar date

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [FCALL, gdate, SELECTA, month]

DEBUG CR, CR, "Calendar Date ", CR

GOSUB Print_Float

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [FCALL, gdate, SELECTA, day]

DEBUG CR

GOSUB Print_Float

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [FCALL, gdate, SELECTA, year]

DEBUG CR

GOSUB Print_Float

DEBUG CR, CR, "done", CR

END

'==============================
' uM-FPU64 SPI support routines
'==============================

Fpu_Reset:

SHIFTOUT FpuOut, FpuClk, MSBFIRST,
[$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF]

PAUSE 10

' check for synchronization

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [SYNC]

GOTO Fpu_Status2

Fpu_Wait:

' (required for 2-wire interface)

INPUT FpuIn

Fpu_Wait2:

' wait until uM-FPU is ready

IF (FpuIn = 1) THEN GOTO Fpu_Wait2

RETURN

Fpu_ReadStatus:

' read status byte

GOSUB Fpu_Wait

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [READSTATUS]

Fpu_Status2:

SHIFTIN FpuIn, FpuClk, MSBPRE, [status]

RETURN

Print_Version:

' print the uM-FPU version string

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [VERSION]

GOTO Print_FpuString

Print_Float:

' set format to zero (free format)
' (fall through to Print_FloatFormat)

format = 0

Print_FloatFormat:

' convert floating point to formatted ASCII

opcode = FTOA

GOTO Print_Format

Print_Long:

' set format to zero (free format)
' (fall through to Print_FloatFormat)

format = 0

Print_LongFormat:

' convert long integer to formatted ASCII
' (fall through to Print_Format)

opcode = LTOA

Print_Format:

' send conversion command

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [opcode, format]

Print_FpuString:

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [SETREAD]

' wait until uM-FPU is ready

GOSUB Fpu_Wait

SHIFTOUT FpuOut, FpuClk, MSBFIRST, [READSTR]

DO

' display zero terminated string

SHIFTIN FpuIn, FpuClk, MSBPRE, [dataByte]

IF (dataByte = 0) THEN EXIT

DEBUG dataByte

LOOP

RETURN