[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/19/99 21:25:07 DATECONV - LS-DOS 6.3 Page 00001
00001 ;DATECONV/ASM - 6.3 Date Conversion Program
00003 ; 01/14/86 - Add set 63h version # at gat+CB when done
00004 ;
000A 00005 LF EQU 10
000D 00006 CR EQU 13
4296 00007 BLNKMPW EQU 4296H
00008 ;
0000 00009 *GET SVCMAC:3 ;SVC Macro equivalents
00010 ;SVCMAC/ASM - LS-DOS Version VI
00011 *LIST OFF
00403 *LIST ON
0000 00405 *GET COPYCOM:3 ;Copyright message
00406 ; COPYCOM - File for Copyright COMment block
00407 ;
0000 00408 *GET BUILDVER/ASM:3
00409 ;
00410 ; Buildver/asm is a bit of a kludge since not all utilities can load
00411 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00412 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00413 ; for programs that can use that.
00414 ;
FFFF 00415 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00416 ; These switches activate patches made since the 1B release.
00417 ; It is important that all earlier patches be enabled when a higher
00418 ; patch is enabled.
00419 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00420 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00421 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00422 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00423 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00424 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00425 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00426 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00427 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00428 ;
00429 ;End of BUILDVER/ASM
00430 IF @BLD631
00432 ELSE
00433 COM '<*(C) 1982,3,4,6 by LSI*>'
00434 ENDIF
00435 ;
2600 00436 ORG 2600H
00437 BEGIN
00438 IF @BLD631
2600 ED731926 00439 LD (STACK),SP ;<631>Save entry stack
2604 00440 @@CKBRKC ;<631>Check for break
2604+3E6A 00441 LD A,106
2606+EF 00442 RST 40
2607 C26527 00443 JP NZ,ABORT ;<631>abort
00444 ELSE
00445 @@CKBRKC ;Check for break
00446 JR Z,BEGINA ;Continue if not
00447 LD HL,-1 ; else abort
00448 RET
00449 ;
00450 BEGINA
00451 LD (STACK),SP ;Save entry stack
00452 ENDIF
260A E5 00453 PUSH HL ;Save ptr to cmdline
260B 217027 00454 LD HL,HELLO$ ;Display the signon
260E CD2227 00455 CALL $DSPLY
2611 E1 00456 POP HL
2612 CD1F26 00457 CALL PGRM ;Normal exit is via RET
00458 ;
00459 ; Set exit condition..
00460 ;
2615 210000 00461 $EXIT LD HL,0 ;Init for no error
2618 310000 00462 QUIT$ LD SP,$-$ ;P/u original stack
2619 00463 STACK EQU $-2
261B 00464 @@CKBRKC ;Clear break before exit
261B+3E6A 00465 LD A,106
261D+EF 00466 RST 40
261E C9 00467 RET
00468 ;
261F 7E 00469 PGRM LD A,(HL) ;Ck for drive entered
2620 FE20 00470 CP ' ' ;Bypass leading spaces
2622 23 00471 INC HL
2623 28FA 00472 JR Z,PGRM
2625 FE3A 00473 CP ':' ;Colon indicator?
2627 C26B27 00474 JP NZ,ILLEG ;Quit if not
262A 7E 00475 LD A,(HL) ;P/u drive
262B D630 00476 SUB '0' ;Cvrt to binary
262D DA6B27 00477 JP C,ILLEG ;Bad drive #
2630 FE08 00478 CP 8 ;Bigger than 7?
2632 D26B27 00479 JP NC,ILLEG ;Quit if so
00480 ;
2635 322C27 00481 LD (DRIVE1),A
2638 323E27 00482 LD (DRIVE2),A ;Save for read and write
263B 23 00483 DOPRM: INC HL ;See if any params
263C 7E 00484 LD A,(HL)
263D FE0E 00485 CP CR+1 ;End?
263F 3811 00486 JR C,NOPRM ;Go if so
2641 FE20 00487 CP ' ' ;Space?
2643 28F6 00488 JR Z,DOPRM ;Bypass
2645 FE28 00489 CP '('
2647 20F2 00490 JR NZ,DOPRM
2649 117D28 00491 LD DE,PRMTBL
264C 00492 @@PARAM
264C+3E11 00493 LD A,17
264E+EF 00494 RST 40
264F C24627 00495 JP NZ,IOERR
2652 3A2C27 00496 NOPRM: LD A,(DRIVE1) ;Get back drive
2655 4F 00497 LD C,A
2656 00498 @@CKDRV ;Be sure disk is in
2656+3E21 00499 LD A,33
2658+EF 00500 RST 40
2659 C26B27 00501 JP NZ,ILLEG
265C DA5B27 00502 JP C,WPDRV
265F 00503 @@GTDCT
265F+3E51 00504 LD A,81
2661+EF 00505 RST 40
00506 ;
2662 FD7E09 00507 LD A,(IY+9) ;Get dir cyl
2665 329526 00508 LD (DIR1),A
2668 57 00509 LD D,A ;Set to read GAT
2669 1E00 00510 LD E,0
266B CD3A27 00511 CALL RDSEC ;Read the GAT
266E 110000 00512 LD DE,$-$ ;See if force all
266F 00513 CSPARM EQU $-2
2671 7A 00514 LD A,D
2672 B3 00515 OR E
2673 201F 00516 JR NZ,DOIT ;Go if it is
2675 3ACD29 00517 LD A,(BUF1+0CDH) ;Get the type byte
2678 CB5F 00518 BIT 3,A ;Have some new already?
267A CA8226 00519 JP Z,DOOLD ;Go if not
267D 32C726 00520 LD (HAVNEW),A ;Else set new on
2680 1812 00521 JR DOIT ; and start
2682 CB7F 00522 DOOLD BIT 7,A ;Is it a system disk?
2684 200E 00523 JR NZ,DOIT ;Start if not
2686 110200 00524 LD DE,2 ;If sys disk,
2689 CD3A27 00525 CALL RDSEC ; must check version
268C 7E 00526 LD A,(HL)
268D FE63 00527 CP 63H ;Cannot be earlier
268F 2803 00528 JR Z,DOIT ;Go if 6.3 or later
2691 C35727 00529 JP NOT2SYS ; else abort
00530 ;
00531 ; Get directory records
00532 ;
2694 1600 00533 DOIT LD D,$-$
2695 00534 DIR1 EQU $-1
2696 1E03 00535 LD E,3 ;Read directory
2698 CD3A27 00536 CALL RDSEC
269B 3A1429 00537 LD A,(BUF1+20) ;Get the ERN of DIR
269E D601 00538 SUB 1
26A0 FE21 00539 CP 33 ;Max allowed is 34 total
26A2 3802 00540 JR C,SET1 ;Go if ok
26A4 3E21 00541 LD A,33 ; else set max sectors number
26A6 32F826 00542 SET1 LD (MAXSEC),A ;Save for countdown
00543 ;
00544 ; Main driving loop
00545 ;
26A9 1E02 00546 LD E,2 ;Starting directory record
26AB CD3A27 00547 DIRLOOP CALL RDSEC
26AE E5 00548 DIRLP1 PUSH HL
26AF CB7E 00549 BIT 7,(HL) ;FXDE?
26B1 C2E626 00550 JP NZ,DONXT ;Go if so
26B4 CB66 00551 BIT 4,(HL) ;Alive?
26B6 CAE626 00552 JP Z,DONXT ;Go if not
26B9 2C 00553 INC L
26BA 2C 00554 INC L
26BB 7E 00555 LD A,(HL) ;Get the date
26BC B7 00556 OR A ;Was one set?
26BD 2827 00557 JR Z,DONXT ;Go if not
26BF E607 00558 AND 7 ;Save possible year
26C1 4F 00559 LD C,A ; in C
26C2 7D 00560 LD A,L ;Pt to date/time or pswd
26C3 C610 00561 ADD A,16 ; as the case may be
26C5 6F 00562 LD L,A
26C6 3E00 00563 LD A,$-$ ;Are there new files?
26C7 00564 HAVNEW EQU $-1
26C8 B7 00565 OR A
26C9 2810 00566 JR Z,NONEW ;Go if not
26CB D5 00567 PUSH DE
26CC E5 00568 PUSH HL ;Save direc locn
26CD 119642 00569 LD DE,BLNKMPW ;See if this file has
26D0 7E 00570 LD A,(HL)
26D1 23 00571 INC HL
26D2 66 00572 LD H,(HL)
26D3 6F 00573 LD L,A ; a blank password
26D4 B7 00574 OR A
26D5 ED52 00575 SBC HL,DE
26D7 E1 00576 POP HL
26D8 D1 00577 POP DE
26D9 200B 00578 JR NZ,DONXT ;Go if not
00579 ;
00580 ; Do this file
00581 ;
26DB 3600 00582 NONEW LD (HL),0 ;Xfer hours,mins
26DD 23 00583 INC HL
26DE 71 00584 LD (HL),C ;Xfer mins,year
26DF 2A8828 00585 LD HL,(CNT)
26E2 23 00586 INC HL
26E3 228828 00587 LD (CNT),HL ;Inc count of matches
00588 ;
26E6 00589 DONXT @@CKBRKC
26E6+3E6A 00590 LD A,106
26E8+EF 00591 RST 40
26E9 C25F27 00592 JP NZ,WASBRK ;Quit on break
26EC E1 00593 POP HL
26ED 7D 00594 LD A,L
26EE C620 00595 ADD A,20H
26F0 6F 00596 LD L,A
26F1 C2AE26 00597 JP NZ,DIRLP1 ;Go if more this sect
26F4 CD2827 00598 CALL WRSYS ;Write the dir sector
26F7 3E00 00599 LD A,$-$
26F8 00600 MAXSEC EQU $-1
26F9 1C 00601 INC E ;Next sector
26FA BB 00602 CP E ;Are we done?
26FB D2AB26 00603 JP NC,DIRLOOP ;Cont if not
00604 ;
00605 ; Update GAT type byte
00606 ;
26FE 1E00 00607 LD E,0
2700 CD3A27 00608 CALL RDSEC
2703 3ACD29 00609 LD A,(BUF1+0CDH) ;Get the type byte
2706 F608 00610 OR 8 ;Set the bit
2708 32CD29 00611 LD (BUF1+0CDH),A ; put it back
00612 IF @BLD631
270B 3E63 00613 LD A,63H ;<631>Update version # in GAT
270D 32CB29 00614 LD (BUF1+0CBH),A ;<631>
2710 CD2827 00615 CALL WRSYS ;<631>
00616 ELSE
00617 CALL PATCH1
00618 ENDIF
00619 ;
00620 ; Show how many found
00621 ;
2713 2A8828 00622 LD HL,(CNT) ;Get count of changes
2716 11F727 00623 LD DE,CNTMSG$
2719 D5 00624 PUSH DE
271A 00625 @@HEXDEC
271A+3E61 00626 LD A,97
271C+EF 00627 RST 40
271D E1 00628 POP HL
271E 00629 @@LOGOT
00630 IFEQ 00H,1
00631 LD HL,
00632 ENDIF
271E+3E0C 00633 LD A,12
2720+EF 00634 RST 40
2721 C9 00635 RET ;All done
00636 ;
00637 ; Support subroutines
00638 ;
2722 00639 $DSPLY @@DSPLY ;Display a line
00640 IFEQ 00H,1
00641 LD HL,
00642 ENDIF
2722+3E0A 00643 LD A,10
2724+EF 00644 RST 40
2725 C8 00645 RET Z
2726 181E 00646 JR IOERR
00647 ;
00648 ; Write the current sector
00649 ;
2728 210029 00650 WRSYS LD HL,BUF1
272B 0E00 00651 LD C,$-$
272C 00652 DRIVE1 EQU $-1
272D 00653 @@WRSSC
272D+3E36 00654 LD A,54
272F+EF 00655 RST 40
2730 2014 00656 JR NZ,IOERR
2732 00657 @@VRSEC
2732+3E32 00658 LD A,50
2734+EF 00659 RST 40
2735 FE06 00660 CP 6
2737 200D 00661 JR NZ,IOERR
2739 C9 00662 RET
00663 ;
00664 ;
00665 ; Sector read routine
00666 ;
273A 210029 00667 RDSEC LD HL,BUF1 ;Read sector
273D 0E00 00668 LD C,$-$
273E 00669 DRIVE2 EQU $-1
273F 00670 @@RDSEC
273F+3E31 00671 LD A,49
2741+EF 00672 RST 40
2742 C8 00673 RET Z
2743 FE06 00674 CP 6
2745 C8 00675 RET Z ;Fall thru to error?
00676 ;
00677 ; Error exits
00678 ;
2746 FE3F 00679 IOERR CP 63 ;Extended error?
2748 2818 00680 JR Z,EXTERR ;Log it and quit
274A 2600 00681 LD H,0 ;Error to HL
274C 6F 00682 LD L,A
274D E5 00683 PUSH HL ;Save error code
274E F6C0 00684 OR 0C0H ;Set short, return
2750 4F 00685 LD C,A ;Error to C for
2751 00686 @@ERROR ; display
2751+3E1A 00687 LD A,26
2753+EF 00688 RST 40
2754 E1 00689 POP HL ;Recover error code
2755 1811 00690 JR QUIT$$
00691 ;
00692 ; Internal error handler
00693 ;
2757 213A28 00694 NOT2SYS LD HL,NOT2SYS$ ;"Can't do 6.2 sys disk
275A DD 00695 DB 0DDH
275B 216728 00696 WPDRV LD HL,WPDRV$ ;"Write protected drive
275E DD 00697 DB 0DDH
275F 212228 00698 WASBRK LD HL,ABTJOB$
2762 00699 EXTERR @@LOGOT ;Display the error
00700 IFEQ 00H,1
00701 LD HL,
00702 ENDIF
2762+3E0C 00703 LD A,12
2764+EF 00704 RST 40
00705 IF @BLD631
00706 ABORT:
00707 ENDIF
2765 21FFFF 00708 LD HL,-1 ;Set abort code
2768 C31826 00709 QUIT$$ JP QUIT$
00710 ;
276B 3E20 00711 ILLEG LD A,32 ;'illegal drv #'
276D C34627 00712 JP IOERR
00713 ;
00714 ;
00715 ; Messages
00716 ;
2770 44 00717 HELLO$ DB 'DATECONV'
41 54 45 43 4F 4E 56
2778 00718 *GET CLIENT:3
00719 ;CLIENT/ASM - File to establish sign-on headers
00720 ; and version numbers.
00721 ;
00722 ; EACH STRING SHOULD CONTAIN ONLY 63 CHARACTERS !!
00723 ;
00724 IF @BLD631
00725 ; 12345678901234567890123456789012345678901234567890
2778 20 00726 DB ' - 6.3.1 - Copyright 1982/83/84/86/90 by MISOSYS, ';<631>
2D 20 36 2E 33 2E 31 20
2D 20 43 6F 70 79 72 69
67 68 74 20 31 39 38 32
2F 38 33 2F 38 34 2F 38
36 2F 39 30 20 62 79 20
4D 49 53 4F 53 59 53 2C
20
27AA 49 00727 DB 'Inc., ',10 ;<631>
6E 63 2E 2C 20 20 20 20
20 20 20 0A
00728 ELSE
00729 DB ' - 6.3.0 - Copyright 1982/83/84/86 by Logical Syst'
00730 DB 'ems, Inc. ',10
00731 ENDIF
00732 ;
00733 ; DB 'All Rights Reserved. Licensed 1982/83/84 to Tandy '
00734 ; DB 'Corporation.',10,13
00735 ;
00736 ; DB 'All Rights Reserved. Beta-TEST Level/AD, DO NOT DI'
00737 ; DB 'STRIBUTE !! ',10,13
00738 ; DB 'All Rights reserved by LSI, 8970 N. 55th St. Milwa'
00739 ; DB 'ukee, Wisc. ',10,13
27B7 41 00740 DB 'All Rights Reserved. Unauthorized duplication is p'
6C 6C 20 52 69 67 68 74
73 20 52 65 73 65 72 76
65 64 2E 20 55 6E 61 75
74 68 6F 72 69 7A 65 64
20 64 75 70 6C 69 63 61
74 69 6F 6E 20 69 73 20
70
27E9 72 00741 DB 'rohibited. ',10,13
6F 68 69 62 69 74 65 64
2E 20 20 0A 0D
00742 ;
27F7 20 00743 CNTMSG$ DB ' file(s) updated, conversion complete',CR
20 20 20 20 20 66 69 6C
65 28 73 29 20 75 70 64
61 74 65 64 2C 20 63 6F
6E 76 65 72 73 69 6F 6E
20 63 6F 6D 70 6C 65 74
65 0D
2822 44 00744 ABTJOB$ DB 'Date conversion aborted',CR
61 74 65 20 63 6F 6E 76
65 72 73 69 6F 6E 20 61
62 6F 72 74 65 64 0D
283A 43 00745 NOT2SYS$ DB 'Can''t convert dates on a non-6.3 '
61 6E 27 74 20 63 6F 6E
76 65 72 74 20 64 61 74
65 73 20 6F 6E 20 61 20
6E 6F 6E 2D 36 2E 33 20
285B 53 00746 DB 'SYSTEM disk',CR
59 53 54 45 4D 20 64 69
73 6B 0D
2867 57 00747 WPDRV$ DB 'Write protected drive',CR
72 69 74 65 20 70 72 6F
74 65 63 74 65 64 20 64
72 69 76 65 0D
00748 ;
287D 80 00749 PRMTBL DB 80H
287E 42 00750 DB 42H
287F 43 00751 DB 'CS'
53
2881 00 00752 DB 0
2882 6F26 00753 DW CSPARM
2884 0000 00754 DW 0
2886 00 00755 MINS DB 0
2887 00 00756 HOURS DB 0
2888 0000 00757 CNT DW 0
00758 ;
2900 00759 ORG $<-8+1<+8
2900 00760 BUF1 DS 256
00761 IF @BLD631
00762 ELSE
00763 PATCH1 LD A,63H ;Update version # in GAT
00764 LD (BUF1+0CBH),A
00765 JP WRSYS
00766 ENDIF
00767 ;
2600 00768 END BEGIN
2600 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]