[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/11/99 02:15:16 RENAME - LS-DOS 6.2 Page 00001
00001 ;LBRENAME/ASM - RENAME Command
00003 ;
0000 00004 *GET BUILDVER/ASM:3
00005 ;
00006 ; Buildver/asm is a bit of a kludge since not all utilities can load
00007 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00008 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00009 ; for programs that can use that.
00010 ;
FFFF 00011 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00012 ; These switches activate patches made since the 1B release.
00013 ; It is important that all earlier patches be enabled when a higher
00014 ; patch is enabled.
00015 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00016 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00017 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00018 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00019 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00020 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00021 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00022 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00023 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00024 ;
00025 ;End of BUILDVER/ASM
0000 00026 *GET SVCMAC:3 ;SVC Macro equivalents
00027 ;SVCMAC/ASM - LS-DOS Version VI
00028 *LIST OFF
00420 *LIST ON
0000 00422 *GET VALUES:3 ;Misc. equates
00423 ;VALUES/ASM - Version 6
00424 *LIST OFF
00451 *LIST ON
00452 ;
0000 00453 INH EQU 0 ;Inhibit LRL Fault
00454 ;
2400 00455 ORG 2400H
00456 ;
00457 RENAME
00458 IF @BLD631
2400 ED732E24 00459 LD (SAVESP+1),SP ;<631>Save SP
00460 ENDIF
2404 00461 @@CKBRKC ;Break key down?
2404+3E6A 00462 LD A,106
2406+EF 00463 RST 40
00464 IF @BLD631
2407 2021 00465 JR NZ,ABORT ;<631>abort
00466 ELSE
00467 JR Z,BEGINA ;Ok if not
00468 LD HL,-1 ; else abort
00469 RET
00470 ;
00471 BEGINA LD (SAVESP+1),SP ;Save SP
00472 ENDIF
2409 CD3424 00473 CALL RENAM ;Rename File/Device
240C 210000 00474 LD HL,0 ;Init successful
240F 281C 00475 JR Z,SAVESP ;Z - successful rename
00476 ;
00477 ; I/O Error Processing
00478 ;
2411 6F 00479 IOERR LD L,A ;Error # to HL
2412 2600 00480 LD H,0
2414 F6C0 00481 OR 0C0H ;Set to brief & return
2416 4F 00482 LD C,A ;Xfer error code
2417 00483 @@ERROR
2417+3E1A 00484 LD A,26
2419+EF 00485 RST 40
241A 1811 00486 JR SAVESP ;Restore stack & RET
00487 ;
00488 ; Internal Message Error Processing
00489 ;
241C 21BF25 00490 SPCERR LD HL,SPCERR$
241F DD 00491 DB 0DDH
2420 21D325 00492 DUPNAM LD HL,DUPNAM$
2423 DD 00493 DB 0DDH
2424 21E725 00494 TOWHAT LD HL,TOWHAT$
2427 00495 @@LOGOT
00496 IFEQ 00H,1
00497 LD HL,
00498 ENDIF
2427+3E0C 00499 LD A,12
2429+EF 00500 RST 40
00501 IF @BLD631
00502 ABORT
00503 ENDIF
242A 21FFFF 00504 LD HL,-1
00505 ;
00506 ; Clean up stack & clear any pending s
00507 ;
242D 310000 00508 SAVESP LD SP,$-$ ;P/u original SP
2430 00509 @@CKBRKC ;Clear any
2430+3E6A 00510 LD A,106
2432+EF 00511 RST 40
2433 C9 00512 RET
00513 ;
00514 ; RENAM - Rename a filespec or devspec
00515 ;
2434 E5 00516 RENAM PUSH HL ;Save cmd line ptr
2435 117126 00517 LD DE,TEMPFCB ;Xfer Filespec to buffer
2438 00518 @@FSPEC
2438+3E4E 00519 LD A,78
243A+EF 00520 RST 40
243B E1 00521 POP HL ;Ignore error
243C 00522 @@FLAGS ;IY => Flag Table
243C+3E65 00523 LD A,101
243E+EF 00524 RST 40
243F 111F26 00525 LD DE,OLDFCB ;Get filespec
2442 00526 @@FSPEC
2442+3E4E 00527 LD A,78
2444+EF 00528 RST 40
2445 20D5 00529 JR NZ,SPCERR ;Quit if bad source name
2447 11FF25 00530 LD DE,NEWFCB ;Get new name
244A 00531 @@FSPEC
244A+3E4E 00532 LD A,78
244C+EF 00533 RST 40
244D C43825 00534 CALL NZ,CVRTUC ;Cvrt partial spec to UC
2450 3AFF25 00535 REN1 LD A,(NEWFCB) ;If new name starts out
2453 FE0F 00536 CP CR+2 ; with something less
2455 DA2424 00537 JP C,TOWHAT ; than X'0E', to what ?
2458 211F26 00538 LD HL,OLDFCB
245B 11FF25 00539 LD DE,NEWFCB
245E 7E 00540 LD A,(HL) ;Check on device rename
245F FE2A 00541 CP '*'
2461 CA0225 00542 JP Z,DEVREN
2464 1A 00543 LD A,(DE) ;Old is file, new must
2465 FE2A 00544 CP '*' ; be also
2467 28B3 00545 JR Z,SPCERR
00546 ;
00547 ; Renaming Files - Can we OPEN old file ?
00548 ;
2469 117126 00549 LD DE,TEMPFCB ;Can we OPEN it ?
246C FDCB12C6 00550 SET INH,(IY+SFLAG$) ;Inhibit open bit set
2470 00551 @@OPEN
2470+3E3B 00552 LD A,59
2472+EF 00553 RST 40
2473 C0 00554 RET NZ ;NZ - "File not Found"
2474 ED4B7726 00555 LD BC,(TEMPFCB+6) ;P/u drive #/DEC
00556 ;
00557 ; Good Open - Is there a drivespec in string ?
00558 ;
2478 E5 00559 PUSH HL ;Save ptr
2479 7E 00560 FLOOP LD A,(HL) ;P/u char
247A FE0E 00561 CP CR+1 ;End of Filespec ?
247C 300F 00562 JR NC,CHKDSPC
00563 ;
00564 ; Drivespec wasn't specified - put it on
00565 ;
247E 363A 00566 LD (HL),':' ;Append drivespec onto
2480 23 00567 INC HL ; end of filespec
2481 79 00568 LD A,C ;Xfer drive # to A
2482 C630 00569 ADD A,'0' ;Convert to ASCII
2484 77 00570 LD (HL),A
2485 32A524 00571 LD (OLD_DRV+1),A ;Self-modify NEW FCB
2488 23 00572 INC HL ;Bump
2489 360D 00573 LD (HL),CR ;End of filespec
248B 1809 00574 JR DOMATCH ;Get defaults
00575 ;
00576 ; Stop when ":" hit or terminator
00577 ;
248D FE3A 00578 CHKDSPC CP ':' ;Already have one ?
248F 23 00579 INC HL
2490 20E7 00580 JR NZ,FLOOP
2492 7E 00581 LD A,(HL) ;P/u drive #
2493 32A524 00582 LD (OLD_DRV+1),A ;Self-modify NEW FCB
2496 E1 00583 DOMATCH POP HL ;HL => Old FCB
2497 11FF25 00584 LD DE,NEWFCB ;DE => New FCB
249A CD5D25 00585 CALL MATCH
00586 ;
00587 ; Make sure NEW drivespec is same as OLD one
00588 ;
249D D5 00589 PUSH DE ;Save New
249E 1A 00590 F2LOOP LD A,(DE) ;Go until ":"
249F 13 00591 INC DE
24A0 FE3A 00592 CP ':'
24A2 20FA 00593 JR NZ,F2LOOP
24A4 3E00 00594 OLD_DRV LD A,$-$ ;P/u OLD drivespec
24A6 12 00595 LD (DE),A ;Overwrite
24A7 D1 00596 POP DE ;Restore DE
00597 ;
00598 ; Does the NEW filename already exist ?
00599 ;
24A8 E5 00600 PUSH HL ;Save OLD ptr
24A9 D5 00601 PUSH DE ;Save NEW ptr
24AA EB 00602 EX DE,HL
24AB 117126 00603 LD DE,TEMPFCB ;DE => Temp buffer
24AE FDCB12C6 00604 SET INH,(IY+SFLAG$)
24B2 00605 @@FSPEC ;Xfer filespec
24B2+3E4E 00606 LD A,78
24B4+EF 00607 RST 40
24B5 00608 @@OPEN ;File already exist ?
24B5+3E3B 00609 LD A,59
24B7+EF 00610 RST 40
24B8 CA2024 00611 JP Z,DUPNAM ;Error if so
24BB D1 00612 POP DE ;Restore ptrs
24BC E1 00613 POP HL
24BD E5 00614 REN2 PUSH HL ;OLD Filename/Device
24BE D5 00615 PUSH DE ;NEW Filename/Device
00616 ;
00617 ; Xfer the OLD & NEW specs to SPEC$ minus PASSWORD
00618 ;
24BF 114926 00619 LD DE,SPECS$
24C2 CDE124 00620 CALL MOVSPC ;Move the OLD spec
24C5 21FA25 00621 LD HL,TO$
24C8 010400 00622 LD BC,4
24CB EDB0 00623 LDIR ;Move ' to '
24CD E1 00624 POP HL ;Recover NEW spec
24CE E5 00625 PUSH HL
24CF CDE124 00626 CALL MOVSPC ;Move the NEW spec
24D2 3E0D 00627 LD A,CR
24D4 12 00628 LD (DE),A ;Terminate with CR
24D5 00629 @@LOGOT RENAM$ ;Send names to video
00630 IFEQ 01H,1
24D5+213F26 00631 LD HL,RENAM$
00632 ENDIF
24D8+3E0C 00633 LD A,12
24DA+EF 00634 RST 40
24DB E1 00635 POP HL ;Recover new
24DC D1 00636 POP DE ;Recover old
24DD 00637 @@RENAM ;Rename file
24DD+3E38 00638 LD A,56
24DF+EF 00639 RST 40
24E0 C9 00640 RET ;Return with condition
00641 ;
00642 ; MOVSPC - Create Secondary Spec
00643 ;
24E1 7E 00644 MOVSPC LD A,(HL) ;P/u a spec character
24E2 FE2F 00645 CP '/' ;Extension ?
24E4 2008 00646 JR NZ,CKSPACE ;No - check if space
24E6 23 00647 INC HL ;Is the next character
24E7 7E 00648 LD A,(HL) ; valid ?
24E8 FE41 00649 CP 'A'
24EA 3802 00650 JR C,CKSPACE ;No - don't output it
24EC 2B 00651 DEC HL ;Back one
24ED 7E 00652 LD A,(HL) ;P/u slash
24EE FE20 00653 CKSPACE CP ' '
24F0 D8 00654 RET C ;Exit on terminator
24F1 FE2E 00655 CP '.' ;If password, ignore it
24F3 2009 00656 JR NZ,MOVSPC1
24F5 23 00657 SKIPPW INC HL
24F6 7E 00658 LD A,(HL)
24F7 FE20 00659 CP ' '
24F9 D8 00660 RET C ;Back on terminator
24FA FE3A 00661 CP ':'
24FC 20F7 00662 JR NZ,SKIPPW
24FE EDA0 00663 MOVSPC1 LDI ;Move the char
2500 18DF 00664 JR MOVSPC
00665 ;
00666 ; Routine to rename a device
00667 ;
2502 1A 00668 DEVREN LD A,(DE) ;Old was device, new must
2503 FE2A 00669 CP '*' ; also be a device spec
2505 C21C24 00670 JP NZ,SPCERR ;Abort if bad
00671 ;
00672 ; Does the Source Devspec exist ?
00673 ;
2508 E5 00674 PUSH HL ;Save Old Device name
2509 D5 00675 PUSH DE ;Save New Device name
250A 23 00676 INC HL ;Bump past "*"
250B 5E 00677 LD E,(HL) ;Set DE = Device name
250C 23 00678 INC HL
250D 56 00679 LD D,(HL)
250E 00680 @@GTDCB ;Does it exist ?
250E+3E52 00681 LD A,82
2510+EF 00682 RST 40
2511 C21124 00683 JP NZ,IOERR ;NZ - "Dev not Available"
00684 ;
00685 ; P/u the Job Log DCB Address (last DCB)
00686 ;
2514 44 00687 LD B,H ;Save DCB ptr in BC
2515 4D 00688 LD C,L
2516 114A4C 00689 LD DE,'LJ' ;Find *JL
2519 00690 @@GTDCB
2519+3E52 00691 LD A,82
251B+EF 00692 RST 40
251C 23 00693 INC HL ;Pt HL => Past Protected
251D B7 00694 OR A ; system Device table.
251E ED42 00695 SBC HL,BC ;Protected Device ?
2520 3E28 00696 LD A,40 ;Init errcode
2522 D21124 00697 JP NC,IOERR ;Jump on error
00698 ;
00699 ; Does the destination device already exist ?
00700 ;
2525 E1 00701 POP HL ;HL => New Devspec
2526 E5 00702 PUSH HL
2527 23 00703 INC HL ;Bump past "*"
2528 5E 00704 LD E,(HL) ;Set DE = Device name
2529 23 00705 INC HL
252A 56 00706 LD D,(HL)
252B 00707 @@GTDCB ;Already Exist ?
252B+3E52 00708 LD A,82
252D+EF 00709 RST 40
252E 3E27 00710 LD A,39 ;Yes - Device in use
2530 CA1124 00711 JP Z,IOERR
2533 D1 00712 POP DE ;Restore NEW & OLD ptrs
2534 E1 00713 POP HL
2535 C3BD24 00714 JP REN2
00715 ;
00716 ; Routine xfers partial filespec & cvrts to UC
00717 ;
2538 7E 00718 CVRTUC LD A,(HL)
2539 FE0D 00719 CP CR
253B C8 00720 RET Z ;Ret if no new name
253C 2B 00721 DEC HL ;Backup to 1st separator
253D 7E 00722 COP0 LD A,(HL)
253E 23 00723 INC HL
253F FE20 00724 CP ' ' ;Skip past spaces
2541 28FA 00725 JR Z,COP0
2543 2B 00726 DEC HL
2544 0620 00727 LD B,32 ;Max 32 chars
2546 7E 00728 COP1 LD A,(HL) ;Transfer the partial
2547 FE61 00729 COP2 CP 'a' ;Cvrt lc to uc
2549 3806 00730 JR C,COP3
254B FE7B 00731 CP 'z'+1
254D 3002 00732 JR NC,COP3
254F D620 00733 SUB 20H
2551 12 00734 COP3 LD (DE),A ;Filespec until paren
2552 FE0D 00735 CP CR ; or
2554 C8 00736 RET Z
2555 FE28 00737 CP '('
2557 C8 00738 RET Z
2558 23 00739 INC HL ; or end-of-line
2559 13 00740 INC DE ; or 32 chars max
255A 10EA 00741 DJNZ COP1
255C C9 00742 RET
00743 ;
00744 ; Match source & destination for defaults
00745 ;
255D D5 00746 MATCH PUSH DE ;Save NEW spec
255E E5 00747 PUSH HL ;Save OLD spec
255F 1A 00748 LD A,(DE) ;P/u a dest character
2560 FE41 00749 CP 'A'
2562 DC9F25 00750 CALL C,MATCH7 ;Match if not a filename
2565 062F 00751 LD B,'/'
2567 CD7825 00752 CALL MATCH2
256A 063A 00753 LD B,':'
256C CD7825 00754 CALL MATCH2
256F 062E 00755 LD B,'.'
2571 CD7825 00756 CALL MATCH2
2574 E1 00757 POP HL
2575 D1 00758 POP DE
2576 C9 00759 RET
00760 ;
2577 13 00761 MATCH1 INC DE
2578 1A 00762 MATCH2 LD A,(DE) ;Scan destination until
2579 B8 00763 CP B ; the test character is
257A 280E 00764 JR Z,MATCH3 ; found or until some
257C FE41 00765 CP 'A' ; other special char
257E 30F7 00766 JR NC,MATCH1 ; is reached
2580 FE30 00767 CP '0' ;Loop on <0-9>
2582 3808 00768 JR C,MATCH4
2584 FE3A 00769 CP '9'+1
2586 38EF 00770 JR C,MATCH1
2588 1802 00771 JR MATCH4
258A 13 00772 MATCH3 INC DE
258B C9 00773 RET
00774 ;
00775 ; Found some other special char - Need the field
00776 ;
258C E5 00777 MATCH4 PUSH HL ;Save pointer to source
258D 7E 00778 MATCH5 LD A,(HL) ;Scan source until the
258E 23 00779 INC HL ; desired field is
258F FE03 00780 CP ETX ; found (if it is
2591 280A 00781 JR Z,MATCH6 ; supplied by the user)
2593 FE0D 00782 CP CR
2595 2806 00783 JR Z,MATCH6
2597 B8 00784 CP B
2598 20F3 00785 JR NZ,MATCH5
259A CDAB25 00786 CALL MATCH9 ;Move source field
259D E1 00787 MATCH6 POP HL
259E C9 00788 RET
00789 ;
00790 ; Routines to move a source field to destination
00791 ;
259F 7E 00792 MATCH7 LD A,(HL) ;P/u source character
25A0 FE30 00793 CP '0' ;Back when out of range
25A2 D8 00794 RET C
25A3 FE3A 00795 CP '9'+1
25A5 3803 00796 JR C,MATCH8
25A7 FE41 00797 CP 'A'
25A9 D8 00798 RET C
25AA 23 00799 MATCH8 INC HL ;Advance source ptr
25AB E5 00800 MATCH9 PUSH HL ;Save HL and make it
25AC 62 00801 LD H,D ; the destination ptr
25AD 6B 00802 LD L,E
25AE 4E 00803 MATCH10 LD C,(HL) ;Get char at destination
25AF 77 00804 LD (HL),A ; and put in new one
25B0 23 00805 INC HL ;Next dest loc.
25B1 79 00806 LD A,C ;What was there?
25B2 FE03 00807 CP ETX ;Go until ETX
25B4 2804 00808 JR Z,MATCH11
25B6 FE0D 00809 CP CR ; or end of line
25B8 20F4 00810 JR NZ,MATCH10
25BA 77 00811 MATCH11 LD (HL),A
25BB E1 00812 POP HL
25BC 13 00813 INC DE
25BD 18E0 00814 JR MATCH7
00815 ;
25BF 53 00816 SPCERR$ DB 'Specification error',CR
70 65 63 69 66 69 63 61
74 69 6F 6E 20 65 72 72
6F 72 0D
25D3 44 00817 DUPNAM$ DB 'Duplicate file name',CR
75 70 6C 69 63 61 74 65
20 66 69 6C 65 20 6E 61
6D 65 0D
25E7 52 00818 TOWHAT$ DB 'Rename it to what?',CR
65 6E 61 6D 65 20 69 74
20 74 6F 20 77 68 61 74
3F 0D
25FA 20 00819 TO$ DB ' to ',ETX
74 6F 20 03
25FF 0D 00820 NEWFCB DB CR ;Init to cr
2600 00821 DS 31
261F 00822 OLDFCB DS 32
263F 52 00823 RENAM$ DB 'Renaming: '
65 6E 61 6D 69 6E 67 3A
20
2649 00824 SPECS$ DS 40
2671 00825 TEMPFCB DS 32
2691 0000 00826 OLD_FIL DW 0
2693 00827 LAST EQU $
00828 ;
2400 00829 END RENAME
2400 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]