-
Notifications
You must be signed in to change notification settings - Fork 0
/
tardis.s
658 lines (649 loc) · 20.1 KB
/
tardis.s
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
; %help
; tardis - Get date/time from TimeLord server.
;
; options:
; -v Verbose mode, prints server and other info
; -n <nbp-name> Specify NBP query, default =:TimeLord@*
; -p Set ProDOS global page date/time
; -y Patch ProDOS year table to use returned year
; -s <type> Set a clock of <type>, current supported
; types: none
; -e <hours> Adjust time eastward
; -w <hours> Adjust time westward
; %hend
; Notes: AFP epoch is 12:00 AM January 1, 2000 GMT.
; Mac epoch is 12:00 AM January 1, 1904 GMT.
; the difference is 3029529600 ($b492f400) seconds
; Mac epoch is returned by TimeLord.
; AFP epoch is expected by WS Card ConvertTime function.
; The general algorithm is:
; Request the date from TimeLord.
; Subtract the epoch difference from the response to get AFP time.
; Use the FIConvertTime call to convert to ProDOS date and time.
; That gives us month/day/year/hour/minute
; To get seconds:
; Convert the ProDOS date and time back to AFP time.
; This number should be <= the AFP time we got above because the seconds are assumed
; to be 0.
; Subtract to get the seconds.
; In practice this does not work with the Apple II Workstation Card because its
; FIConvertTime function is buggy. It is sometimes off by 2 mins or more and the
; reverse conversion gives garbage.
; The IIgs this algo works perfect.
; So for now we don't give seconds on a IIe.
; Should probably rewrite this to just do the math rather than use FIConverTime.
.pc02
.include "davex-mg.inc"
;ch = $24 ; cursor horizontal pos
TL_OK = 12
TL_BAD = 10
entname = filebuff2 ; buffer to build NBP entity name
NBPBuf = filebuff3 ; buffer for NBP request
NBPBufSz = $0400 ; size of the file buffer
P8DtTm = $bf90
;prbyte = $fdda
sptr = xczpage
sptr2 = sptr+2
stemp = sptr2+2
verbose = stemp+1 ; verbose flag
seconds = verbose+1 ; holds seconds
notgs = seconds + 1
DX_start dx_mg_auto_origin ; load address
DX_info $03,$12,dx_cc_iie_or_iigs,$00
DX_ptab
DX_parm 'v',t_nil ; verbose
DX_parm 'n',t_string ; name
DX_parm 'z',t_string ; zone
DX_parm 'p',t_nil ; set prodos time
DX_parm 'y',t_nil ; patch year table
DX_parm 's',t_string ; set clock
DX_parm 'e',t_int1 ; east adjust
DX_parm 'w',t_int1 ; west adjust
DX_end_ptab
DX_desc "Get time from TimeLord server."
DX_main
sec
jsr $FE1F ; GS ID
ror notgs ; notGS now negative if it's not a GS
cli ; appletalk requires interrupts
ATcall inforeq
bcc :+
jmp noatalk
: stz verbose
lda #'v'|$80 ; verbose
jsr xgetparm_ch
bcs :+
inc verbose
: lda #<entname
sta sptr
lda #>entname
sta sptr+1
; get name
lda #'n'|$80 ; NBP name param
jsr xgetparm_ch
bcc :+ ; was specified
; name param not given, use default
lda #<entname
sta sptr
lda #>entname
sta sptr+1
ldy #$00
ldx #<defname
lda #>defname
jsr copystr
ldx #<deftype
lda #>deftype
jsr copystr
ldx #<defzone
lda #>defzone
jsr copystr
jmp doit
: ldx #$80 ; name, return wildcard if not given
jsr get_nbp
bcs badnbp
inx
txa
jsr addsptr
; get type
lda #'n'|$80
jsr xgetparm_ch
ldx #$01 ; type, return empty if not given
jsr get_nbp
bcc :+
ldy #$00
ldx #<deftype
lda #>deftype
jsr copystr
tya
bra :++ ; to addsptr
: inx
txa
: jsr addsptr
; get zone
lda #'n'+$80
jsr xgetparm_ch
ldx #$82 ; zone, return * if not given
jsr get_nbp
bcc doit
badnbp: lda #$01
jsr xredirect
jsr xmess
asc_hi "Bad NBP name."
.byte $00
bra exiterr1
doit: lda #<entname
sta sptr
lda #>entname
sta sptr+1
lda verbose
beq :+ ; don't print unless verbose
jsr prnbptup
jsr xmess
.byte $8d,$00
; Locate TimeLord on network
: ATcall lookup
bcc :+ ; no error, don't bail
notlord: lda #$01
jsr xredirect
jsr xmess
asc_hi "No TimeLord found!"
.byte $00
exiterr1: jmp exiterr
: lda matches ; check # matches
beq notlord ; no matches
; Copy found address/socket to request
ldx #3
: lda NBPBuf,x
sta ATPaddr,x
dex
bpl :-
lda verbose
beq :+
; display NBP entry if verbose
lda bufp+1 ; set up pointer to response buffer
sta sptr+1
lda bufp
sta sptr
jsr prnbpent
; now make ATP request to TimeLord
: lda #$01
sta ATPbmap
ATcall ATPparms
bcc :+
jmp notime ; if error, bail now
; see if verbose
: lda #'v'|$80
jsr xgetparm_ch
bcs :++ ; skip if not verbose
; display raw returned data in hex in little-endian format
ldx #$03
: lda To,x
phx
jsr prbyte
plx
dex
bpl :-
; display timelord status byte from user bytes
lda #'/'|$80
jsr cout
lda Status
jsr prbyte
lda #$8d
jsr cout
; check status
: lda Status
cmp #TL_OK
bne notime1
; now do big-endian subtraction of the base offset
; and simultaneously put the computed value in From
sec
ldx #$03
: lda To,x
sbc Base,x
sta From,x
dex
bpl :-
; Apply user-requested adjustments:
lda #'e'|$80
jsr xgetparm_ch
bcs ckwest
cpy #$01
bcc ckwest
; now do big-endian addition of eastward adjustment
: clc
ldx #$03
: lda From,x
adc Hour,x
sta From,x
dex
bpl :-
dey
bne :--
ckwest: lda #'w'|$80
jsr xgetparm_ch
bcs convert
cpy #$01
bcc convert
; do big-endian subtraction of westward adjustment
: sec
ldx #$03
: lda From,x
sbc Hour,x
sta From,x
dex
bpl :-
dey
bne :--
; Use the WS card to convert value in From to ProDOS format in To
convert: ATcall CvtParms
bcs notime1 ; bail if error
ATcall ResetSec ; sigh... weird firmware
bcs notime1
bit notgs
stz seconds
bmi setp8 ; skip calculate seconds if not IIgs
; calculate seconds
; Copy converted values to the other convert parm list
ldx #$03
: lda To,x
sta SecFrom,x
dex
bpl :-
ATcall SecParms ; convert back
bcc :+
notime1: jmp notime ; bail if error
: lda From+3
sec
sbc SecTo+3
sta seconds
; set Prodos date/time if asked
setp8: lda #'p'|$80 ; set prodos date/time?
jsr xgetparm_ch
bcs nosetp8 ; skip if -p not given
; Copy converted values to the global page
ldx #$03
: lda To,x
sta P8DtTm,x
dex
bpl :-
; patch year table?
nosetp8: lda #'y'|$80
jsr xgetparm_ch
bcs nosetyt
lda $c08b
lda $c08b
ldx #$03
: lda $d7b4,x ; tdays table, at september
cmp tdaysv,x ; that what ProDOS has?
bne setyterr ; not the thunderclock driver
dex
bpl :-
lda To+1 ; year (b7-1), upper bit of month (b0)
lsr
ldx #6
: sta $d7b8,x ; address of year table
dex
bpl :-
bit $c082 ; ROM back
bra nosetyt
setyterr: bit $c082 ; ROM back
lda #$01
jsr xredirect
jsr xmess
asc_hi "Can't patch clock driver!"
.byte $00
bra exiterr
nosetyt: ; TODO: set NSC or ThunderClock or something
; Display date/time
ldy To
lda To+1
jsr xpr_date_ay
jsr xmess
asc_hi " "
.byte $00
ldy To+2
lda To+3
jsr xpr_time_ay
bit notgs
bmi nosec
jsr xmess
asc_hi " +"
.byte $00
ldy seconds
cpy #10
bcs :+
lda #'0'|$80
jsr cout ; leading zero
: ldy seconds
lda #$00 ; zero high byte
jsr xprdec_2 ; print seconds
jsr xmess
.byte "s"
.byte $8d,$00
rts
nosec: lda #$8d
jsr cout
rts
notime: lda #$01
jsr xredirect
jsr xmess
asc_hi "Error getting date/time!"
.byte $00
bra exiterr
noatalk: lda #$01
jsr xredirect
jsr xmess
asc_hi "AppleTalk offline!"
.byte $00
exiterr: lda #$ff
jsr xredirect
jmp xerr
; ***
; get_nbp - get part of a name at ay and copy to sptr
; x = 0:name 1:type 2:zone, +$80 sub wildcard or default if none given
; return: (sptr) = string, x = length of it
.proc get_nbp
sty sptr2
sta sptr2+1
stx stemp
ldy #$00
sty colon ; init these
sty at
lda sptr ; copy sptr to self-modifying wrtdest
sta wrtdest+1
lda sptr+1
sta wrtdest+2
jsr incdest ; and move to first char position
lda (sptr2),y ; length
beq notfound ; zero, just give up
sta end
; find the delimiters
tay
: lda (sptr2),y
cmp #':'
bne notcolon
sty colon
notcolon: cmp #'@'
bne nxtdelim
sty at
nxtdelim: dey
bne :-
; now make sure that if @ is given, it is after :
lda at
beq :+
cmp colon
bcc bad
; now get the part requested
: lda stemp
and #$7f
beq getname
cmp #$01
beq gettype
getzone: ldy at
beq notfound
cpy end
beq notfound
; need to copy from at(+1) to end
docopy: ldx #$00
: iny
lda (sptr2),y
jsr wrtdest
cpy end ; was that the last char
bcc :- ; nope, next char
ldy #$00
txa
sta (sptr),y ; save copied length
clc
rts ; and return
getname: ldy colon
bne :+
ldy at
beq :++
: dey
sty end
: ldy end
beq notfound
ldy #$00 ; initially at pos 0
; need to copy from pos 1 to end
beq docopy ; always
gettype: ldy colon
beq notfound ; early out if no colon
cpy end
beq notfound
ldy at
beq :+ ; use end as-is
dey ; otherwise end at pos before @
sty end
: ldy colon
; need to copy from colon(+1) to end
bne docopy ; should be always
notfound: lda stemp
and #$80
bne :+ ; if client asked for a default
lda #$00
tay
tax ; x is officially length of string result
sta (sptr),y ; put a zero in destination
bad: sec ; tell client we gave an empty string
rts
: ldx #$01 ; length of default
ldy #$00
txa
sta (sptr),y
iny
lda stemp
cmp #$82 ; want default zone? ('*')
bne :++ ; nope
lda #'*'
: sta (sptr),y
clc
rts
: lda #'=' ; wildcard for name or type
bne :-- ; always
wrtdest: sta $ffff
inx ; inc count of copied chars
incdest: inc wrtdest+1
bne :+
inc wrtdest+2
: rts
colon: .byte $00
at: .byte $00
end: .byte $00
.endproc
;
; print an NBP entry at sptr
.proc prnbpent
ldy #$00 ; offset into entry, net number low byte
lda (sptr),y ; big end of network num
pha
iny
lda (sptr),y
tay
pla
jsr xprdec_2
jsr xmess
asc_hi "."
.byte $00
; print node
ldy #$02
lda (sptr),y
tay
lda #$00
jsr xprdec_2
jsr xmess
asc_hi ":"
.byte $00
; print socket
ldy #$03
lda (sptr),y
tay
lda #$00
jsr xprdec_2
jsr xmess
asc_hi " " ; print space in case output is not to screen.
.byte $00
;lda #20 ; Position NBP tuple on screen.
;sta ch
lda #$05 ; offset to NBP tuple
jsr addsptr
jsr prnbptup
jsr xmess ; CR
.byte $8d,$00
rts
.endproc
; print an NBP tuple at sptr
; leave sptr at byte just after tuple
; does not print zone unless verbose flag set
.proc prnbptup
; print name
jsr prpas
jsr xmess
asc_hi ":"
.byte $00
; print type
jsr prpas
lda verbose
beq skipzone ; if not verbose, don't display @zone
jsr xmess
asc_hi "@"
.byte $00
; print zone
jsr prpas
bra :+
skipzone: ldy #$00
lda (sptr),y ; get length of zone name
inc a ; account for length byte
jsr addsptr ; and skip the lot
: rts ; done
.endproc
; increment sptr by a
.proc addsptr
clc
adc sptr
sta sptr
bcc :+
inc sptr+1
: rts
.endproc
; print pascal string at sptr
; leave sptr pointed at one past end
; of string
.proc prpas
ldy #$00
lda (sptr),y ; get length
tax
next: lda #$01
jsr addsptr
dex
bpl :+
rts
: lda (sptr),y ; get char
ora #$80 ; make printable
jsr cout
bra next
.endproc
; copy a pascal string to sptr offset by y
; a,x = source
; return: y = new offset after copied str
.proc copystr
sta sptr2+1
stx sptr2
sty stemp ; save offset
ldy #$00
lda (sptr2),y ; get number of chars
tax ; to copy
ldy stemp ; get the offset
sta (sptr),y ; store the length byte
inc stemp ; increment the offset
inc sptr2 ; next source char
bne :+
inc sptr2+1
: ldy #0
; copy loop
: phy
lda (sptr2),y
ldy stemp
sta (sptr),y
inc stemp
ply
iny
dex
bne :-
ldy stemp
rts
.endproc
;
; table to validate the P8 tclock driver, 4 bytes at $d7b4
tdaysv: .byte 242,20,51,81
;
inforeq: .byte 0,2 ; sync GetInfo
.word $0000 ; result code
.dword $00000000 ; completion address
thisnet: .word $0000 ; this network #
abridge: .byte $00 ; local bridge
hwid: .byte $00 ; hardware ID, IIgs only
romver: .word $00 ; ROM version, IIgs only
nodenum: .byte $00 ; node number
; some pointers & values for building names
defname: .byte 1,"=" ; object
deftype: .byte 8,"TimeLord" ; type
defzone: .byte 1,"*" ; zone
; Base offset for epoch conversion, in big-endian order
;Base: .byte $B4,$93,$56,$70 ; PDT
Base: .byte $b4,$92,$f4,$00 ; GMT - set timezone or use adjust options
; Hours adjustment value
Hour: .byte $00,$00,$0e,$10 ; 3600 seconds
; parameter list for NBPLookup
lookup: .byte 0,16 ; sync NBPLookup
.word $0000 ; result
.dword $00000000 ; completion
.dword entname ; pointer to name to find
.byte 4,4 ; 4 times, every 1 sec
.word $0000 ; reserved
.word NBPBufSz ; buffer size
bufp: .dword NBPBuf ; buffer loc
.byte 1 ; matches wanted
matches: .byte $00 ; matches found
; ATP request parameters
ATPparms: .byte 0,18 ; sync SendATPReq
.word $0000 ; result
.dword $00000000 ; compl. addr
.byte $00 ; socket #
ATPaddr: .dword $00000000 ; destination address
.word $0000 ; TID
.word $0000 ; req buffer size
.dword $00000000 ; req buffer addr
.dword $00000000 ; user bytes, $00 = get time
.byte $01 ; one response buffer
.dword BDS ; pointer to response BDS
.byte $00 ; ATP flags
.byte 4,4 ; try 4 times every 1/4 second
ATPbmap: .byte $00 ; bitmap of blocks to recieve
.byte $00 ; number of responses
.res 6 ; 6 bytes reserved
; BDS for ATP request
BDS: .word $0004 ; 4-byte buffer for basic response from TimeLord
.dword To ; Buffer pointer
Status: .dword $00000000 ; returned user bytes, first byte = 12 if OK
.word $0000 ; actual length
; Convert time parameters - P8 to network for calculating seconds
SecParms: .byte 0,$34 ; sync ConvertTime
.word $0000 ; result
.byte $01 ; 1 = ProDOS to AFP
SecFrom: .dword $00000000
SecTo: .dword $00000000
; Convert time to reset seconds to 0 because the firmware saves the seconds
; and reuses it when converting from P8 to network time.
ResetSec: .byte 0,$34 ; sync ConvertTime
.word $0000 ; result
.byte $00 ; 0 = from AFP to ProDOS, 1 = reverse
.dword $00000000 ; BIG ENDIAN, Jan 1, 2000 12:00 AM GMT
.dword $00000000 ; P8 Time
; Convert time parameters - network to P8
; note that ATP response is written to From
CvtParms: .byte 0,$34 ; sync ConvertTime
.word $0000 ; result
CvtDir: .byte $00 ; 0 = from AFP to ProDOS, 1 = reverse
From: .dword $00000000
To: .dword $00000000 ; initially contains time from ATP response
DX_end