LS-DOS 6.3.1 - SYS2 Assembly Listing (HTML format version)

[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 22:42:31 SYS2 - LS-DOS 6.3            Page 00001 

              00001 ;SYS2/ASM - LS-DOS 6.3
              00003 ;
              00004 ; This SYS module performs the following functions:
              00005 ; . OPENs an existing File or Device
              00006 ; . INITs a new File
              00007 ; . Checks availability of a specific drive
              00008 ; . Hashes an 11-byte field (file name & ext)
              00009 ; . Hashes an 8-byte field (password)
              00010 ; . Renames a filespec/devspec
              00011 ; . Gets the address of a device control block
              00012 ;
000D          00013 CR      EQU     13
              00014 *LIST   OFF                     ;Get SYS0/EQU
              00330 *LIST   ON
0000          00331 *GET    COPYCOM:3               ;Copyright message
              00332 ; COPYCOM - File for Copyright COMment block
              00333 ;
0000          00334 *GET BUILDVER/ASM:3
              00335 ;
              00336 ;       Buildver/asm is a bit of a kludge since not all utilities can load
              00337 ;       equates from LDOS60 and still compile.  LOWCORE and everybody else
              00338 ;       relies on this setting, and it eventually ends up in LDOS60/EQU
              00339 ;       for programs that can use that.
              00340 ;
FFFF          00341 @BLD631         EQU     -1      ;<631>Build 631 distribution (LEVEL 1B)
              00342 ;       These switches activate patches made since the 1B release.
              00343 ;       It is important that all earlier patches be enabled when a higher
              00344 ;       patch is enabled.
              00345 ;       Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
              00346 ;       patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF          00347 @BLD631C        EQU     -1      ;<631>Apply 1C patches (SETKI)
FFFF          00348 @BLD631D        EQU     -1      ;<631>Apply 1D patches (DIR)
FFFF          00349 @BLD631E        EQU     -1      ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF          00350 @BLD631F        EQU     -1      ;<631>Apply 1F patches (SPOOL)
              00351 ;       Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF          00352 @BLD631G        EQU     -1      ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF          00353 @BLD631H        EQU     -1      ;<631>Apply 1H patches (MEMORY)
              00354 ;
              00355 ;End of BUILDVER/ASM
              00356         IF      @BLD631
              00358         ELSE
              00359         COM     '<*(C) 1982,3,4,6 by LSI*>'
              00360         ENDIF
              00361 ;
1E00          00362         ORG     1E00H
              00363 ;
1E00 E670     00364 SYS2    AND     70H             ;Strip all but entry
1E02 C8       00365         RET     Z               ;Back on zero entry
1E03 FE10     00366         CP      10H             ;Check for OPEN
1E05 CA5E1F   00367         JP      Z,OPEN
1E08 FE20     00368         CP      20H             ;Check for INIT
1E0A CA1821   00369         JP      Z,INIT
1E0D FE70     00370         CP      70H             ;Check for rename
1E0F CA1722   00371         JP      Z,RENAME
1E12 FE30     00372         CP      30H             ;Get a DCB?
1E14 2849     00373         JR      Z,GTDCB
1E16 FE40     00374         CP      40H             ;Drive availability?
1E18 2860     00375         JR      Z,CKDRV
1E1A FE60     00376         CP      60H             ;Check password hash
1E1C 2810     00377         JR      Z,HASHPSWD
              00378 ;
              00379 ;       Routine to hash a file name
              00380 ;
              00381 HASHNAME
1E1E 060B     00382         LD      B,11            ;Init for 11 chars
1E20 AF       00383         XOR     A               ;Clear for start
1E21 AE       00384 HNAME1  XOR     (HL)            ;Modulo 2 addition
1E22 23       00385         INC     HL              ;Bump to next character
1E23 07       00386         RLCA                    ;Rotate bit structure
1E24 10FB     00387         DJNZ    HNAME1          ;  & loop for field len
1E26 B7       00388         OR      A               ;Do not permit a zero
1E27 2001     00389         JR      NZ,HNAME2       ;  hash code
1E29 3C       00390         INC     A
1E2A 32DC22   00391 HNAME2  LD      (FILEHASH),A    ;Stuff code for later
1E2D C9       00392         RET
              00393 ;
              00394 ;       Hash a password
              00395 ;
              00396 HASHPSWD
1E2E 210700   00397         LD      HL,7            ;Hashing will be from
1E31 19       00398         ADD     HL,DE           ;  right to left so
1E32 EB       00399         EX      DE,HL           ;  point to lo-order
1E33 21FFFF   00400         LD      HL,-1           ;Init shift reg to 1's
1E36 0608     00401         LD      B,8             ;Init for 8-char string
1E38 1A       00402 HPSWD1  LD      A,(DE)          ;P/u the next byte
1E39 D5       00403         PUSH    DE              ;  & save the pointer
1E3A 57       00404         LD      D,A
1E3B 5C       00405         LD      E,H
1E3C 7D       00406         LD      A,L             ;Modulo 2 add bits 0-2
1E3D E607     00407         AND     7               ;  to bits 4-6 of the
1E3F 0F       00408         RRCA                    ;  16-bit shift register
1E40 0F       00409         RRCA
1E41 0F       00410         RRCA
1E42 AD       00411         XOR     L
1E43 6F       00412         LD      L,A             ;Shift shift-register
1E44 2600     00413         LD      H,0             ;  left by 4-bits to
1E46 29       00414         ADD     HL,HL           ;  isolate bits 4-7
1E47 29       00415         ADD     HL,HL
1E48 29       00416         ADD     HL,HL
1E49 29       00417         ADD     HL,HL
1E4A AC       00418         XOR     H               ;Mod 2 add SR bits 4-7
1E4B AA       00419         XOR     D               ;Mod 2 add new byte
1E4C 57       00420         LD      D,A             ;Save tempy for hi-order
1E4D 7D       00421         LD      A,L
1E4E 29       00422         ADD     HL,HL
1E4F AC       00423         XOR     H
1E50 AB       00424         XOR     E
1E51 5F       00425         LD      E,A
1E52 EB       00426         EX      DE,HL           ;SR result to HL
1E53 D1       00427         POP     DE              ;P/u pointer to string
1E54 1B       00428         DEC     DE              ;  & point to next byte
1E55 10E1     00429         DJNZ    HPSWD1          ;Loop for field length
1E57 AF       00430         XOR     A
1E58 C9       00431         RET
              00432 ;
              00433 ;       Routine to locate a Device Control Block
              00434 ;
1E59 DD5E01   00435 GETDCB  LD      E,(IX+1)        ;P/u the 2-character
1E5C DD5602   00436         LD      D,(IX+2)        ;  device name
1E5F 210802   00437 GTDCB   LD      HL,KIDCB$       ;Point to 1st DCB
1E62 E5       00438 DEV1    PUSH    HL
1E63 7D       00439         LD      A,L             ;Point to device
1E64 C606     00440         ADD     A,6             ;  name field
1E66 6F       00441         LD      L,A
1E67 7E       00442         LD      A,(HL)          ;P/u 1st char of name
1E68 2C       00443         INC     L               ;Point to 2nd char
1E69 BB       00444         CP      E               ;Compare 1st for match
1E6A 2006     00445         JR      NZ,DEV2         ;No match? then loop
1E6C 7E       00446         LD      A,(HL)          ;1st matches, does 2nd?
1E6D BA       00447         CP      D
1E6E 2002     00448         JR      NZ,DEV2         ;Loop if no match
1E70 E1       00449         POP     HL              ;Get start of DCB
1E71 C9       00450         RET
1E72 F1       00451 DEV2    POP     AF              ;Pop last DCB start
1E73 2C       00452         INC     L               ;Inc to start of next DCB
1E74 20EC     00453         JR      NZ,DEV1         ;Bypass if not at end
              00454 ;
              00455 ;       Device not found in tables
              00456 ;
1E76 3E08     00457         LD      A,8             ;"device not available"
1E78 B7       00458         OR      A
1E79 C9       00459         RET
              00460 ;
              00461 ;       Check a drive for availability
              00462 ;
1E7A FDE5     00463 CKDRV   PUSH    IY              ;We use IY in disk I/O
1E7C CD1E1A   00464         CALL    @GTDCT          ;Get driver routine addr
1E7F FD7E00   00465         LD      A,(IY+0)        ;P/u drive vector
1E82 FEC3     00466         CP      0C3H            ;Ck for enabled
1E84 C2311F   00467         JP      NZ,CKDR5        ;Bypass if disabled
1E87 E5       00468         PUSH    HL
1E88 D5       00469         PUSH    DE
1E89 FDCB035E 00470         BIT     3,(IY+3)        ;Test for HARD drive
1E8D 2019     00471         JR      NZ,CKDRV1A      ;If so bypass range check
1E8F FD7E06   00472         LD      A,(IY+6)        ;Make sure the current
1E92 FDBE05   00473         CP      (IY+5)          ;  cylinder is in range
1E95 3006     00474         JR      NC,CKDRV1       ;Go if in range
1E97 CDC819   00475         CALL    @RSTOR          ;Restore drive
1E9A C2401F   00476         JP      NZ,CKDR7A       ;Go if error
              00477 ;
1E9D FD5605   00478 CKDRV1  LD      D,(IY+5)        ;P/u current track
1EA0 1E00     00479         LD      E,0             ;Set for sector 0
1EA2 CDD019   00480         CALL    @SEEK           ;Set track info to FDC
1EA5 C2401F   00481         JP      NZ,CKDR7A       ;Go if error
1EA8 CDD419   00482 CKDRV1A CALL    @RSLCT          ;Wait until not busy
1EAB C2401F   00483         JP      NZ,CKDR7A       ;Not there - ret NZ
1EAE FDCB035E 00484         BIT     3,(IY+3)        ;If hard drive, bypass
1EB2 2032     00485         JR      NZ,CKDR2B       ;  index pulse
1EB4 FDCB0466 00486         BIT     4,(IY+4)        ;If "ALIEN" by pass
1EB8 202C     00487         JR      NZ,CKDR2B       ;  test of index pulses
              00488         IF      @MOD4
1EBA 3A0E00   00489         LD      A,(FDDINT$)     ;Check 'SMOOTH' state
1EBD B7       00490         OR      A
1EBE 3E09     00491         LD      A,09            ;Set MSB of count down
1EC0 2803     00492         JR      Z,INTRON        ;Go if not SMOOTH
1EC2 CB3F     00493         SRL     A               ;Divide the count by two
1EC4 F3       00494         DI
              00495         ENDIF
              00496         IF      @MOD2
              00497         LD      A,20
              00498         ENDIF
1EC5 32D71E   00499 INTRON  LD      (CDCNT+1),A     ;Store in 'LD H' instruction
1EC8 212000   00500         LD      HL,0020H        ;Set up count (short)
              00501 ;
              00502 ;       Test for diskette in drive & rotating
              00503 ;
1ECB CD341F   00504 CKDR1   CALL    INDEX           ;Test index pulse
1ECE 20FB     00505         JR      NZ,CKDR1        ;Jump on index
1ED0 FDCB047E 00506         BIT     7,(IY+4)        ;Check CKDRV inhibit bit
1ED4 2010     00507         JR      NZ,CKDR2B       ;If on skip index test
1ED6 2600     00508 CDCNT   LD      H,00H           ;CKDRV counter (long)
              00509                                 ;Count set from above
1ED8 CD341F   00510 CKDR2   CALL    INDEX           ;Test index pulse
1EDB 28FB     00511         JR      Z,CKDR2         ;Jump on no index
              00512         IF      @MOD4
1EDD FB       00513         EI                      ;OK for INTs now
              00514         ENDIF
1EDE 212000   00515         LD      HL,0020H        ;Index off wait (short)
1EE1 CD341F   00516 CKDR2A  CALL    INDEX
1EE4 20FB     00517         JR      NZ,CKDR2A       ;Jump on index
              00518 ;
              00519 ;       Diskette is rotating
              00520 ;
1EE6 F5       00521 CKDR2B  PUSH    AF              ;Save FDC status
1EE7 CDF718   00522         CALL    @DIRCYL         ;Get directory track in D
1EEA 21001D   00523         LD      HL,SBUFF$       ;Point to HIT buffer
1EED 5D       00524         LD      E,L             ;Sector 0 for GAT
1EEE CDD818   00525         CALL    @RDSSC          ;Read the GAT
1EF1 204C     00526         JR      NZ,CKDR7        ;Jump on error
              00527 ;
              00528 ;       Update YFLAG$ for year type
              00529 ;
1EF3 ED5BCC1D 00530         LD      DE,(SBUFF$+0CCH)        ;Gat type byte
1EF7 79       00531         LD      A,C             ;Drive # to A
1EF8 07       00532         RLCA                    ;Rotate it into posn
1EF9 07       00533         RLCA                    ;For SET x,(hl)
1EFA 07       00534         RLCA                    ; opcode
1EFB F6C6     00535         OR      0C6H            ;For SET opcode
1EFD CB5A     00536         BIT     3,D             ;Is disk new type?
1EFF 2002     00537         JR      NZ,FIXBIT       ;Go if so
1F01 EE40     00538         XOR     40H             ;Else make RES opcode
1F03 320A1F   00539 FIXBIT  LD      (BIT1),A        ;Save opcode
1F06 218200   00540         LD      HL,YFLAG$       ;Pt to year type flag
1F09 CB       00541         DB      0CBH            ;Either SET or RES
1F0A 00       00542 BIT1    DB      0
1F0B FDCB035E 00543         BIT     3,(IY+3)        ;If rigid drive,
1F0F 2012     00544         JR      NZ,CKDR3        ; bypass the rest
1F11 3E22     00545         LD      A,22H           ;Add offset
1F13 83       00546         ADD     A,E
1F14 FD7706   00547         LD      (IY+6),A        ;Max track # to DCT
1F17 FDCB04AE 00548         RES     5,(IY+4)        ;Set to side 0
1F1B CB6A     00549         BIT     5,D             ;Test double sided
1F1D 2804     00550         JR      Z,CKDR3         ;Jump if only single
1F1F FDCB04EE 00551         SET     5,(IY+4)        ;Set for side 2
1F23 F1       00552 CKDR3   POP     AF              ;Recover FDC status
1F24 07       00553 CKDR3A  RLCA                    ;Shift write prot to 7
1F25 FDB603   00554         OR      (IY+3)          ;Merge Soft WP bit
1F28 E680     00555         AND     80H             ;Strip all but 7
1F2A 328020   00556         LD      (OPNCB9+1),A    ;Save WP status for OPNCB
1F2D 87       00557         ADD     A,A             ;Write prot to carry flg
              00558 ;
1F2E          00559 CKDR4   EQU     $
1F2E FB       00560         EI
1F2F D1       00561         POP     DE
1F30 E1       00562         POP     HL
1F31 FDE1     00563 CKDR5   POP     IY
1F33 C9       00564         RET
1F34 7C       00565 INDEX   LD      A,H
1F35 B5       00566         OR      L
1F36 2807     00567         JR      Z,CKDR7
1F38 2B       00568         DEC     HL
1F39 CDD419   00569         CALL    @RSLCT          ;Check for index pulse
1F3C CB4F     00570         BIT     1,A             ;Test index
1F3E C9       00571         RET
1F3F F1       00572 CKDR7   POP     AF
              00573 ;
1F40 B7       00574 CKDR7A  OR      A               ;Set NZ ret
1F41 18EB     00575         JR      CKDR4           ;  and exit
              00576 ;
              00577 ;       OPEN a device
              00578 ;       Device Control Blocks are from X'0208' - X'02FF'
              00579 ;
1F43 CD591E   00580 DEVOPEN CALL    GETDCB          ;Find the DCB named
1F46 C0       00581         RET     NZ              ;  in the IX pointer
              00582 ;
              00583 ;       Found the needed Device Control Block
              00584 ;
1F47 44       00585 DEV4    LD      B,H             ;Xfer dcb vector to BC
1F48 4D       00586         LD      C,L
1F49 DDE5     00587         PUSH    IX              ;User DCB to HL
1F4B E1       00588         POP     HL
1F4C 3610     00589         LD      (HL),10H        ;Show routed
1F4E 23       00590         INC     HL
1F4F 71       00591         LD      (HL),C          ;Stuff dcb vector
1F50 23       00592         INC     HL
1F51 70       00593         LD      (HL),B
1F52 23       00594         INC     HL
1F53 AF       00595         XOR     A               ;Zero next 3 bytes
1F54 77       00596         LD      (HL),A
1F55 23       00597         INC     HL
1F56 77       00598         LD      (HL),A
1F57 23       00599         INC     HL
1F58 77       00600         LD      (HL),A
1F59 23       00601         INC     HL
1F5A 73       00602         LD      (HL),E          ;Stuff dcb name
1F5B 23       00603         INC     HL
1F5C 72       00604         LD      (HL),D
1F5D C9       00605         RET
              00606 ;
              00607 ;
              00608 ;       OPEN a file
              00609 ;        HL <= the address of a 256-byte buffer
              00610 ;        DE <= the address of a 32-byte FCB
              00611 ;         B <= the logical record length (LREC)
              00612 ;
1F5E CD6615   00613 OPEN    CALL    LNKFCB@         ;Set up link to dcb
1F61 3A7C00   00614 OPEN1   LD      A,(SFLAG$)      ;Stuff current sysflag
1F64 323620   00615         LD      (OPEN14+1),A    ;  to check later then
1F67 E6F8     00616         AND     0F8H            ;  remove bits 0, 1 & 2
1F69 327C00   00617         LD      (SFLAG$),A
1F6C DD7E00   00618         LD      A,(IX+0)
1F6F FE2A     00619         CP      '*'             ;If name starts with '*',
1F71 28D0     00620         JR      Z,DEVOPEN       ;  it is a device spec
1F73 78       00621         LD      A,B             ;P/u Lrl requested
1F74 32DB22   00622         LD      (LREC$),A
1F77 22C520   00623         LD      (OPNCB4+1),HL   ;Stuff disk I/O buffer
1F7A DDE5     00624         PUSH    IX              ;Transfer the filespec
1F7C E1       00625         POP     HL              ;  into the system
1F7D CD9E21   00626         CALL    XFRSPEC         ;  buffer area
1F80 C0       00627         RET     NZ              ;Return if bad name
1F81 21C622   00628         LD      HL,NAME$EXT     ;Point to name/ext field
1F84 CD1E1E   00629         CALL    HASHNAME        ;  & hash it (11 chars)
1F87 11BE22   00630         LD      DE,PSWDBUF      ;Point to the password
1F8A CD2E1E   00631         CALL    HASHPSWD        ;  & hash it
1F8D 22D122   00632         LD      (PW$HASH1),HL   ;Stuff owner pswd
1F90 22D322   00633         LD      (PW$HASH2),HL   ;Stuff user pswd
1F93 3E00     00634 OPEN2   LD      A,0             ;P/u drive 
1F95 4F       00635         LD      C,A
1F96 3C       00636         INC     A               ;Jump if :d entered
1F97 2001     00637         JR      NZ,OPEN3
1F99 4F       00638         LD      C,A
1F9A CD7A1E   00639 OPEN3   CALL    CKDRV           ;Drive available?
1F9D 2013     00640         JR      NZ,OPEN6        ;Jump if not
1F9F CD9718   00641         CALL    @HITRD          ;Get hash index table
1FA2 C0       00642         RET     NZ              ;Return if read error
              00643 ;
              00644 ;       Compare hashed filename/ext with each entry
              00645 ;       in the HIT to see if file is on this drive
              00646 ;
1FA3 7E       00647 OPEN4   LD      A,(HL)          ;Bypass HIT entry if
1FA4 B7       00648         OR      A               ;  unused
1FA5 2808     00649         JR      Z,OPEN5
1FA7 E5       00650         PUSH    HL              ;Not vacant
1FA8 21DC22   00651         LD      HL,FILEHASH     ;Point to DEC
1FAB BE       00652         CP      (HL)            ;Compare with HIT entry
1FAC E1       00653         POP     HL
1FAD 2821     00654         JR      Z,OPEN9         ;Jump if a match else
1FAF 2C       00655 OPEN5   INC     L               ;  bump to next entry
1FB0 20F1     00656         JR      NZ,OPEN4        ;Loop until 256 bytes
              00657 ;
              00658 ;       File not on this drive
              00659 ;
1FB2 CDBB1F   00660 OPEN6   CALL    TESTDRV         ;Bump drive if we can
1FB5 38E3     00661         JR      C,OPEN3         ;Loop if another to test
1FB7 3E18     00662 OPEN7   LD      A,24            ;File not found error
1FB9 B7       00663         OR      A
1FBA C9       00664         RET
1FBB 3A941F   00665 TESTDRV LD      A,(OPEN2+1)     ;If drive still X'FF',
1FBE 3C       00666         INC     A               ;  then advance to next
1FBF B7       00667         OR      A               ;Reset Carry for ret w/o
1FC0 C0       00668         RET     NZ              ;  affecting Z/NZ result
1FC1 0C       00669         INC     C               ;Bump drive counter
1FC2 79       00670         LD      A,C
1FC3 FE08     00671         CP      8               ;Loop end, 8 max
1FC5 C9       00672         RET
              00673 ;
              00674 ;       Although the HIT entry matched, the filename/ext
              00675 ;       did not (due to a collision). Continue to scan
              00676 ;       the rest of the hash index table.
              00677 ;
1FC6 C1       00678 OPEN8   POP     BC              ;Remove ret address and
1FC7 E1       00679         POP     HL              ;  excess registers
1FC8 C1       00680         POP     BC
1FC9 CD9718   00681         CALL    @HITRD          ;Re-read the hit
1FCC E1       00682         POP     HL
1FCD C0       00683         RET     NZ              ;Go on i/o error
1FCE 18DF     00684         JR      OPEN5
              00685 ;
              00686 ;       The hashed name matches, read the directory
              00687 ;
1FD0 E5       00688 OPEN9   PUSH    HL
1FD1 C5       00689         PUSH    BC
1FD2 45       00690         LD      B,L             ;Set up the DEC
1FD3 CDBB18   00691         CALL    @DIRRD
1FD6 2803     00692         JR      Z,OPEN10        ;Jump if no error
1FD8 C1       00693         POP     BC              ;  else pop returns
1FD9 E1       00694         POP     HL
1FDA C9       00695         RET                     ;  & exit
              00696 ;
              00697 ;       Verify that directory entry is this file
              00698 ;
1FDB E5       00699 OPEN10  PUSH    HL
1FDC C5       00700         PUSH    BC              ;Save drive (reg C)
              00701 ;
              00702 ;       If bit 7 is set, it denotes an extended
              00703 ;       directory entry which does not include
              00704 ;       the filename. Go to next HIT entry if set
              00705 ;
1FDD CB7E     00706         BIT     7,(HL)          ;Test for FXDE
1FDF 20E5     00707         JR      NZ,OPEN8        ;Jump if extended
1FE1 CB66     00708         BIT     4,(HL)          ;If DIR record spare,
1FE3 28E1     00709         JR      Z,OPEN8         ;  continue to search
1FE5 3E05     00710         LD      A,5             ;Point to filename/ext
1FE7 85       00711         ADD     A,L             ;  field in directory
1FE8 6F       00712         LD      L,A
1FE9 11C622   00713         LD      DE,NAME$EXT     ;Point to entered name
1FEC 060B     00714         LD      B,11            ;Init to check 11 chars
1FEE 1A       00715 OPEN11  LD      A,(DE)          ;Verify a match
1FEF BE       00716         CP      (HL)            ;  or no match
1FF0 20D4     00717         JR      NZ,OPEN8        ;Go to next HIT entry
1FF2 23       00718         INC     HL              ;  if no match; else bump
1FF3 13       00719         INC     DE              ;  pointers & loop
1FF4 10F8     00720         DJNZ    OPEN11
1FF6 C1       00721         POP     BC              ;Matches! get drive #
1FF7 79       00722         LD      A,C             ;  & stuff it
1FF8 32941F   00723         LD      (OPEN2+1),A
1FFB E1       00724         POP     HL
1FFC F1       00725         POP     AF
1FFD F1       00726         POP     AF
1FFE C5       00727         PUSH    BC              ;Save DEC and drive
1FFF E5       00728         PUSH    HL              ;Save ptr to dir record
2000 7E       00729         LD      A,(HL)          ;P/u 1st byte of dir rec
2001 32D722   00730         LD      (DIR$INIT),A    ;Stuff it
2004 E607     00731         AND     7               ;Strip all but protection
2006 4F       00732         LD      C,A
2007 0600     00733         LD      B,0
2009 3E10     00734         LD      A,16            ;Point to update password
200B 85       00735         ADD     A,L
200C 6F       00736         LD      L,A
200D ED5BD322 00737         LD      DE,(PW$HASH2)   ;P/u password hash
2011 7E       00738         LD      A,(HL)          ;P/u owner pswd lo order
2012 23       00739         INC     HL
2013 E5       00740         PUSH    HL
2014 66       00741         LD      H,(HL)          ;P/u owner pswd hi order
2015 6F       00742         LD      L,A
2016 3A7700   00743         LD      A,(NFLAG$)      ;P/u NFLAG$
2019 CB7F     00744         BIT     7,A             ;Check network active bit
201B 2802     00745         JR      Z,USEPWD
201D 54       00746         LD      D,H
201E 5D       00747         LD      E,L
201F AF       00748 USEPWD  XOR     A               ;Compare password entry
2020 ED52     00749         SBC     HL,DE           ;  with owner password
2022 E1       00750         POP     HL
2023 2822     00751 WASMAT  JR      Z,OPEN16        ;Grant access if match
2025 79       00752         LD      A,C             ;Recover protection
2026 FE07     00753         CP      7               ;Abort if "no access"
2028 2006     00754         JR      NZ,OPEN13       ;Have access if not "no"
              00755 ;
              00756 ;       File is password protected - abort
              00757 ;
202A E1       00758 OPEN12  POP     HL
202B C1       00759         POP     BC
202C 3E19     00760         LD      A,25            ;"file access denied"
202E B7       00761         OR      A
202F C9       00762         RET
              00763 ;
              00764 ;       Check if prot is exec only
              00765 ;
2030 79       00766 OPEN13  LD      A,C
2031 FE06     00767         CP      6               ;Check for EXEC ONLY
2033 2012     00768         JR      NZ,OPEN16       ;Jump if not
2035 0600     00769 OPEN14  LD      B,0             ;P/u SFLAG$ entry state
2037 CB50     00770         BIT     2,B             ;Did RUN request open?
2039 2807     00771         JR      Z,OPEN15        ;Bypass if NOT from RUN
203B 217C00   00772         LD      HL,SFLAG$
203E CBCE     00773         SET     1,(HL)          ;Show RUN & EXEC file
2040 3E05     00774         LD      A,5             ;Set read access for now
2042 21791A   00775 OPEN15  LD      HL,SET@EXEC     ;Set RST vector to turn
2045 36C9     00776         LD      (HL),0C9H       ;  off DEBUG
2047 32B520   00777 OPEN16  LD      (OPNCB1+1),A    ;Stuff access level
204A E1       00778         POP     HL              ;Ptr to direc record
204B C1       00779         POP     BC              ;P/u DEC and drive
              00780 ;
              00781 ;       Routine to open up the fcb from the directory
              00782 ;       HL => directory record in SBUFF$
              00783 ;       BC => DEC and drive used for directory read/write
              00784 ;       IX => pointer to File Control Block
              00785 ;
204C FDE5     00786 OPNCB   PUSH    IY              ;Save IY
204E E5       00787         PUSH    HL              ;Transfer direc record
204F FDE1     00788         POP     IY              ;  ptr to IY
2051 C5       00789         PUSH    BC              ;Save DEC and drive
2052 CDA520   00790         CALL    OPNCB0          ;Create the opened FCB
2055 C1       00791         POP     BC
2056 213620   00792         LD      HL,OPEN14+1     ;If from LOAD, don't do
2059 CB46     00793         BIT     0,(HL)          ;  any further checks
205B 2804     00794         JR      Z,OPNEX1
205D AF       00795         XOR     A
205E FDE1     00796 OPNEX   POP     IY
2060 C9       00797         RET
2061 FDCB016E 00798 OPNEX1  BIT     5,(IY+1)        ;If file already open
2065 280F     00799         JR      Z,OPNCB8        ;  then set read-only
2067 FDE1     00800         POP     IY              ;  & return "file open...
2069 DD7E01   00801 OPNEX2  LD      A,(IX+1)        ;P/u current attributes
206C E6F8     00802         AND     0F8H            ;Mask off current prot
206E F605     00803         OR      5               ;  & replace with READ
2070 DD7701   00804         LD      (IX+1),A        ;Reset access to READ
2073 3E29     00805         LD      A,41            ;Set "file already open"
2075 C9       00806         RET
              00807 ;
              00808 ;       If access level is > read, set file open flag in
              00809 ;       the directory & note close authority in the FCB.
              00810 ;
2076 DD7E01   00811 OPNCB8  LD      A,(IX+1)        ;P/u FCB access level
2079 E607     00812         AND     7               ;Mask off other junk
207B FE05     00813         CP      5               ;Ck READ, EXEC, NONE
207D 3017     00814         JR      NC,OPNCB10      ;Go if one of the above
207F 3E00     00815 OPNCB9  LD      A,0             ;P/u CKDRV status
2081 07       00816         RLCA                    ;Was drive write prot?
2082 381C     00817         JR      C,FRCREAD       ;CF = WP
2084 FDCB01EE 00818         SET     5,(IY+1)        ;Set file open in direc
2088 3A7700   00819         LD      A,(NFLAG$)      ;P/u Nflag
208B CB47     00820         BIT     0,A             ;Check for function ON
208D C40318   00821         CALL    NZ,@DIRWR       ;Write the directory
2090 20CC     00822         JR      NZ,OPNEX
2092 DDCB00F6 00823         SET     6,(IX+0)        ;Set close authority
              00824 ;
              00825 ;       Ck if passed LRL matches directory
              00826 ;
2096 DD7E09   00827 OPNCB10 LD      A,(IX+9)        ;P/u LRL from FCB &
2099 FDBE04   00828         CP      (IY+4)          ;  compare with directory
209C 3E2A     00829         LD      A,42            ;Init "LRL open fault
209E 18BE     00830         JR      OPNEX
              00831 ;
              00832 ;       Disk write protected - Change access to READ
              00833 ;
20A0 CD6920   00834 FRCREAD CALL    OPNEX2          ;Change access to READ
20A3 18F1     00835         JR      OPNCB10
              00836 ;
              00837 ;       This routine creates the open file control block
              00838 ;
20A5 EB       00839 OPNCB0  EX      DE,HL
20A6 DDE5     00840         PUSH    IX              ;Transfer fcb pointer
20A8 E1       00841         POP     HL
20A9 1A       00842         LD      A,(DE)          ;Get DIR+0
20AA E620     00843         AND     20H             ;Keep "PDS" bit & show
20AC F680     00844         OR      80H             ;  FCB as open
20AE 77       00845         LD      (HL),A          ;Shove into FCB+0
20AF 23       00846         INC     HL
20B0 3ADB22   00847         LD      A,(LREC$)       ;P/u lrl
20B3 B7       00848         OR      A               ;Test for 0 (256)
20B4 3E00     00849 OPNCB1  LD      A,0             ;Now start byte 2 with
20B6 2802     00850         JR      Z,OPNCB2        ;  that set by "OPEN16"
20B8 F680     00851         OR      80H             ;Show sector or byte I/O
20BA F620     00852 OPNCB2  OR      20H             ;Show buffer is empty
              00853 ;
              00854 ;       Set bit 3 if filespec ended in an
              00855 ;       exclamation point. This causes the
              00856 ;       directory to be updated on every
              00857 ;       file write where the EOF is extended
              00858 ;
20BC F600     00859 OPNCB3  OR      0
20BE 77       00860         LD      (HL),A          ;Init FCB+1
20BF 23       00861         INC     HL
20C0 AF       00862         XOR     A
20C1 77       00863         LD      (HL),A          ;Init FCB+2 with 0
20C2 23       00864         INC     HL
20C3 D5       00865         PUSH    DE              ;Put address of disk I/O
20C4 110000   00866 OPNCB4  LD      DE,0            ;  buf into FCB+3 & FCB+4
20C7 73       00867         LD      (HL),E
20C8 23       00868         INC     HL
20C9 72       00869         LD      (HL),D
20CA 23       00870         INC     HL
20CB D1       00871         POP     DE              ;FCB+5 with 0 for
20CC 77       00872         LD      (HL),A          ;  lo order next
20CD 23       00873         INC     HL
20CE 71       00874         LD      (HL),C          ;FCB+6 with drive
20CF 23       00875         INC     HL
20D0 70       00876         LD      (HL),B          ;FCB+7 with DEC
20D1 23       00877         INC     HL
20D2 13       00878         INC     DE              ;Point to DIR EOF byte
20D3 13       00879         INC     DE
20D4 13       00880         INC     DE
20D5 1A       00881         LD      A,(DE)          ;P/u DIR lo order EOF
20D6 77       00882         LD      (HL),A          ;  & stuff into FCB+8
20D7 23       00883         INC     HL
20D8 13       00884         INC     DE
20D9 3ADB22   00885         LD      A,(LREC$)       ;P/u lrl & stuff
20DC 77       00886         LD      (HL),A          ;  into FCB+9
20DD 23       00887         INC     HL
20DE AF       00888         XOR     A
20DF 77       00889         LD      (HL),A          ;Init FCB+10 & FCB+11
20E0 23       00890         INC     HL              ;  with zero for NRN
20E1 77       00891         LD      (HL),A
20E2 23       00892         INC     HL
20E3 CBE3     00893         SET     4,E             ;Point to file EOF
20E5 010200   00894         LD      BC,2            ;Move ERN
20E8 EB       00895         EX      DE,HL
20E9 EDB0     00896         LDIR                    ;  and zero BC reg
20EB EB       00897         EX      DE,HL
20EC 3E05     00898         LD      A,5             ;Max 5 extents
20EE F5       00899         PUSH    AF
20EF 1A       00900 OPNCB5  LD      A,(DE)          ;Move starting track
20F0 77       00901         LD      (HL),A
20F1 23       00902         INC     HL
20F2 13       00903         INC     DE
20F3 1A       00904         LD      A,(DE)          ;Move grans & offset
20F4 77       00905         LD      (HL),A
20F5 23       00906         INC     HL
20F6 E61F     00907         AND     1FH             ;Strip out grans
20F8 3C       00908         INC     A               ;Bump for zero offset
              00909 ;
              00910 ;       Add reg A to reg pair BC
              00911 ;
20F9 81       00912         ADD     A,C             ;Add previous count
20FA 4F       00913         LD      C,A             ;Update C
20FB 3001     00914         JR      NC,$+3          ;Go if no carry to B
20FD 04       00915         INC     B
20FE F1       00916         POP     AF              ;Recover counter
20FF 3D       00917         DEC     A               ;Decrement loop
2100 C8       00918         RET     Z               ;Done if moved in 5
2101 F5       00919         PUSH    AF
2102 13       00920         INC     DE
2103 1A       00921         LD      A,(DE)          ;Test for end of extents
2104 FEFE     00922         CP      0FEH            ;Extent in use?
2106 3006     00923         JR      NC,OPNCB6       ;Jump if not
2108 71       00924         LD      (HL),C          ;Stuff # of cumulative
2109 23       00925         INC     HL              ;  grans to this
210A 70       00926         LD      (HL),B          ;  allocation into FCB
210B 23       00927         INC     HL
210C 18E1     00928         JR      OPNCB5          ;Loop for next
              00929 ;
              00930 ;       Unused extents - put X'FFFF' in remaining fields
              00931 ;
210E F1       00932 OPNCB6  POP     AF              ;Recover counter
210F 07       00933         RLCA                    ;Make times 4 and
2110 07       00934         RLCA                    ;  fill remaining
2111 47       00935         LD      B,A             ;  extent bytes with
2112 36FF     00936 OPNCB7  LD      (HL),0FFH       ;  0FFH
2114 23       00937         INC     HL
2115 10FB     00938         DJNZ    OPNCB7
2117 C9       00939         RET
              00940 ;
              00941 ;       INIT a file
              00942 ;        HL => the address of a 256-byte buffer
              00943 ;        DE => the address of a 32-byte FCB
              00944 ;         B => the logical record length (LREC)
              00945 ;
2118 CD6615   00946 INIT    CALL    LNKFCB@         ;Link to FCB
211B 32B520   00947         LD      (OPNCB1+1),A    ;Start FCB+1 with 0
211E 3E10     00948         LD      A,10H           ;Init for no prot on
2120 323221   00949         LD      (INIT0),A       ;  a new file
2123 E5       00950         PUSH    HL
2124 217C00   00951         LD      HL,SFLAG$       ;Reset called by RUN bit
2127 CB96     00952         RES     2,(HL)
2129 E1       00953         POP     HL
212A CD611F   00954         CALL    OPEN1           ;Can we "OPEN" the file?
212D C8       00955         RET     Z               ;Return if file existing
212E FE18     00956         CP      24              ;Return if error not
2130 C0       00957         RET     NZ              ;  "file not found"
2131 3E10     00958         LD      A,10H           ;Set dir rec to show
2132          00959 INIT0   EQU     $-1
2133 32D722   00960         LD      (DIR$INIT),A    ;  assigned
2136 3A941F   00961         LD      A,(OPEN2+1)     ;P/u the drive entry
2139 4F       00962         LD      C,A
213A 3C       00963         INC     A               ;Jump if a drive entry
213B F5       00964         PUSH    AF
213C 2001     00965         JR      NZ,INIT1        ;  was made
213E 4F       00966         LD      C,A
213F F1       00967 INIT1   POP     AF              ;Stack integrity
2140 CD7A1E   00968         CALL    CKDRV           ;Is this drive available?
2143 200C     00969         JR      NZ,INIT2        ;Jump if not
2145 380A     00970         JR      C,INIT2         ;  or if write protected
2147 CD9718   00971         CALL    @HITRD          ;Read hash index table
214A C0       00972         RET     NZ              ;Return if read error
214B CD0A22   00973         CALL    SPRHIT          ;Locate spare entry
214E 281F     00974         JR      Z,INIT4         ;Jump if space
2150 AF       00975         XOR     A               ;Set status of CKDRV=Z
2151 F5       00976 INIT2   PUSH    AF              ;Save last CKDRV status
2152 CDBB1F   00977         CALL    TESTDRV
2155 38E8     00978         JR      C,INIT1         ;Loop if not at end
2157 3A941F   00979         LD      A,(OPEN2+1)     ;If drivespec not entered
215A 3C       00980         INC     A               ;  then "directory full
215B 2003     00981         JR      NZ,INIT2A
215D F1       00982         POP     AF              ;Stack integrity
215E 1805     00983         JR      ERR26
2160 F1       00984 INIT2A  POP     AF              ;  else if no drive then
2161 2008     00985         JR      NZ,ERR32        ;  "illegal drive...
2163 3803     00986         JR      C,ERR15         ;  else if write protect
2165 3E1A     00987 ERR26   LD      A,26            ;  "directory space full"
2167 01       00988         DB      1
2168 3E0F     00989 ERR15   LD      A,15            ;"write protect...
216A 01       00990         DB      1
216B 3E20     00991 ERR32   LD      A,32            ;"Illegal drive...
216D B7       00992         OR      A
216E C9       00993         RET
              00994 ;
              00995 ;       Found a spare HIT entry position
              00996 ;
216F 45       00997 INIT4   LD      B,L             ;Save DEC
2170 3ADC22   00998         LD      A,(FILEHASH)    ;P/u filespec hash
2173 77       00999         LD      (HL),A          ;  & store in HIT
2174 CD9818   01000         CALL    @HITWR          ;Write updated HIT
2177 CCBB18   01001         CALL    Z,@DIRRD        ;Read that dir record
217A C0       01002         RET     NZ              ;Return if read error
217B E5       01003         PUSH    HL
217C C5       01004         PUSH    BC
217D EB       01005         EX      DE,HL
217E 010500   01006         LD      BC,5            ;Move 1st 5 bytes into
2181 21D722   01007         LD      HL,DIR$INIT     ;  directory record
2184 EDB0     01008         LDIR
2186 0E11     01009         LD      C,17            ;Move filename & password
2188 21C622   01010         LD      HL,NAME$EXT     ;  info into directory
218B EDB0     01011         LDIR
218D EB       01012         EX      DE,HL
218E 060A     01013         LD      B,10            ;Put X'FFFF' into 5 ext's
2190 CD1221   01014 INIT5   CALL    OPNCB7          ;4 for the ext's & 1 for
2193 C1       01015         POP     BC              ;  staarting info
2194 CD0318   01016         CALL    @DIRWR          ;Write updated directory
2197 E1       01017         POP     HL
2198 C0       01018         RET     NZ              ;Return if write error
2199 CD4C20   01019         CALL    OPNCB           ;  else open the fcb
219C 37       01020         SCF                     ;Indicate new file
219D C9       01021         RET
              01022 ;
              01023 ;       Xfer the file spec to system buffer area
              01024 ;
219E 0613     01025 XFRSPEC LD      B,19
21A0 11BE22   01026         LD      DE,PSWDBUF
21A3 3E20     01027         LD      A,20H           ;Blank out the filename
21A5 12       01028 XSPEC1  LD      (DE),A          ;  field in system buffer
21A6 13       01029         INC     DE
21A7 10FC     01030         DJNZ    XSPEC1
21A9 3EFF     01031         LD      A,0FFH          ;Set drive to X'FF' for
21AB 32941F   01032         LD      (OPEN2+1),A     ;  checking user entry
21AE 1EC6     01033         LD      E,NAME$EXT&0FFH ;Xfer file name
              01034         IF      @BLD631
21B0 CDEE21   01035         CALL    XSPEC8B         ;<631>
              01036         ELSE
              01037         CALL    XSPEC8
              01038         ENDIF
21B3 4F       01039         LD      C,A
21B4 78       01040         LD      A,B
21B5 D608     01041         SUB     8               ;Any valid chars found?
21B7 2003     01042         JR      NZ,XSPEC3       ;Jump if valid name
              01043 ;
              01044 ;       Filename was invalid format
              01045 ;
21B9 F613     01046         OR      19              ;"illegal file name"
21BB C9       01047         RET
              01048 ;
              01049 ;       Continue to check file spec
              01050 ;
21BC 79       01051 XSPEC3  LD      A,C
21BD FE2F     01052         CP      '/'             ;Ext entered?
21BF 1ECE     01053         LD      E,FILE$EXT&0FFH
21C1 0603     01054         LD      B,3
21C3 CCF021   01055         CALL    Z,XSPEC8A       ;Xfer the ext
21C6 FE2E     01056         CP      '.'             ;Password entered?
21C8 1EBE     01057         LD      E,PSWDBUF&0FFH
              01058         IF      @BLD631
21CA CCE921   01059         CALL    Z,XSPEC8        ;<631>Xfer the password
              01060         ELSE
              01061         JR      NZ,XSPEC3A
              01062         LD      A,17H           ;If a password, set init
              01063         LD      (INIT0),A       ; to show "no" prot level
              01064         CALL    XSPEC8          ;Xfer the password
              01065         ENDIF
21CD FE3A     01066 XSPEC3A CP      ':'             ;Drive entered?
21CF 200D     01067         JR      NZ,XSPEC6
21D1 7E       01068         LD      A,(HL)          ;P/u drive #
21D2 D630     01069         SUB     '0'             ;Convert to binary
21D4 32941F   01070         LD      (OPEN2+1),A     ;Stuff drive #
21D7 E6F8     01071         AND     0F8H            ;Must be <0-7>
21D9 3E20     01072         LD      A,32            ;"illegal drive #"
21DB C0       01073         RET     NZ              ;Return error if out
21DC 23       01074         INC     HL              ;  of range
21DD 7E       01075         LD      A,(HL)          ;Does filespec end in
21DE D621     01076 XSPEC6  SUB     21H             ;  exclamation point?
21E0 3E08     01077         LD      A,8             ;Init to set bit 3 of
21E2 2801     01078         JR      Z,XSPEC7        ;  FCB+1 & jump if "!"
21E4 AF       01079         XOR     A               ;  else reset if not
21E5 32BD20   01080 XSPEC7  LD      (OPNCB3+1),A
21E8 C9       01081         RET
              01082 ;
              01083 ;
              01084 ;
              01085 XSPEC8
              01086         IF      @BLD631
21E9 3E17     01087         LD      A,17H           ;If a password, set init
21EB 323221   01088         LD      (INIT0),A       ; to show "no" prot level
              01089 XSPEC8B
              01090         ENDIF
21EE 0608     01091         LD      B,8
21F0 7E       01092 XSPEC8A LD      A,(HL)          ;P/u a filespec character
21F1 23       01093         INC     HL              ;  & 1st test for A-Z
21F2 1809     01094         JR      XSPEC10
21F4 7E       01095 XSPEC9  LD      A,(HL)          ;P/u a filespec character
21F5 23       01096         INC     HL              ;Advance to next one
21F6 FE30     01097         CP      '0'             ;Check for 0-9
21F8 D8       01098         RET     C
21F9 FE3A     01099         CP      '9'+1
21FB 3806     01100         JR      C,XSPEC11
21FD FE41     01101 XSPEC10 CP      'A'             ;Check for A-Z
21FF D8       01102         RET     C
2200 FE5B     01103         CP      'Z'+1
2202 D0       01104         RET     NC
2203 12       01105 XSPEC11 LD      (DE),A          ;Character is valid
2204 13       01106         INC     DE              ;Advance to next one
2205 10ED     01107         DJNZ    XSPEC9          ;  & loop
2207 7E       01108         LD      A,(HL)          ;P/u following character
2208 23       01109         INC     HL
2209 C9       01110         RET
              01111 ;
              01112 ;       Routine to find a spare HIT entry
              01113 ;
220A 3E28     01114 SPRHIT  LD      A,28H           ;Start scan here
220C CD1F18   01115         CALL    @SCNHIT         ;Call to SYSRES
220F C9       01116         RET
              01117 ;
              01118 ;       Routine to rename a filespec/devspec
              01119 ;
2210 3E18     01120 REN0    LD      A,18H
2212 322320   01121         LD      (WASMAT),A
2215 B7       01122         OR      A               ;Denote "file not in dir
2216 C9       01123         RET
2217 CD6615   01124 RENAME  CALL    LNKFCB@         ;Save regs & link to IX
221A DD7E00   01125         LD      A,(IX+0)        ;If a device, use the
221D D62A     01126         SUB     '*'             ;  "device" routine
221F 2879     01127         JR      Z,RENDEV
2221 FEA8     01128         CP      'R'!80H-'*'     ;Special open condition?
2223 28EB     01129         JR      Z,REN0          ;Go if so
2225 E5       01130         PUSH    HL              ;Save new pointer
2226 217C00   01131         LD      HL,SFLAG$       ;Set don't test flags
2229 CBC6     01132         SET     0,(HL)
222B CD611F   01133         CALL    OPEN1           ;Open the "old" spec
222E E1       01134         POP     HL
222F C0       01135         RET     NZ              ;Exit on error
2230 DD7E01   01136         LD      A,(IX+1)        ;Make sure user has
2233 E607     01137         AND     7               ;  permission to rename
2235 FE03     01138         CP      3
2237 3804     01139         JR      C,REN1
2239 3E25     01140         LD      A,25H           ;"Illegal access...
223B B7       01141         OR      A
223C C9       01142         RET
              01143 ;
              01144 ;       User has access to rename - locate drivespec
              01145 ;
223D E5       01146 REN1    PUSH    HL              ;Save start
223E 7E       01147 REN2    LD      A,(HL)          ;P/u char of new spec
223F 23       01148         INC     HL
2240 FE0D     01149         CP      CR
2242 2808     01150         JR      Z,REN3          ;Go on ENTER
2244 FE03     01151         CP      3
2246 2804     01152         JR      Z,REN3          ;Go on ETX
2248 FE3A     01153         CP      ':'
224A 20F2     01154         JR      NZ,REN2         ;Loop on colon
224C 2B       01155 REN3    DEC     HL              ;Backup to where the
224D 363A     01156         LD      (HL),':'        ;  colon should go
224F 23       01157         INC     HL              ;  & force the drivespec
2250 DD7E06   01158         LD      A,(IX+6)        ;  to the same as "old"
2253 4F       01159         LD      C,A             ;Keep drive spec in C
2254 E607     01160         AND     7
2256 C630     01161         ADD     A,'0'           ;Make it an ASCII digit
2258 77       01162         LD      (HL),A
2259 23       01163         INC     HL
225A 360D     01164         LD      (HL),CR
225C DD4607   01165         LD      B,(IX+7)        ;Get DEC
225F DDE1     01166         POP     IX              ;Put "new" FCB into IX
2261 C5       01167         PUSH    BC              ;  & save DEC & drive
2262 217C00   01168         LD      HL,SFLAG$       ;Set don't test flags
2265 CBC6     01169         SET     0,(HL)
2267 CD611F   01170         CALL    OPEN1           ;Open the "new" spec
226A C1       01171         POP     BC
226B 2004     01172         JR      NZ,REN4         ;Should error here
226D 3E13     01173 REN3A   LD      A,19            ;  or else return
226F B7       01174         OR      A               ;  if "new" is existing
2270 C9       01175         RET                     ;  & we opened it
2271 FE18     01176 REN4    CP      24              ;If not "file not found"
2273 C0       01177         RET     NZ              ;  then is error
2274 CDBB18   01178         CALL    @DIRRD          ;Read "old's" directory
2277 C0       01179         RET     NZ
2278 C5       01180         PUSH    BC              ;Save drive spec
2279 54       01181         LD      D,H             ;Xfer buffer hi
227A 7D       01182         LD      A,L
227B C605     01183         ADD     A,5             ;Pt to filename field
227D 5F       01184         LD      E,A             ;Set buffer lo
227E 21C622   01185         LD      HL,NAME$EXT     ;Point to where the
2281 010B00   01186         LD      BC,11           ;  new name is stored
2284 EDB0     01187         LDIR                    ;Move in new name
2286 C1       01188         POP     BC
2287 CD0318   01189         CALL    @DIRWR          ;Rewrite the directory
228A CC9718   01190         CALL    Z,@HITRD        ;Read the HIT
228D C0       01191         RET     NZ
228E 54       01192         LD      D,H             ;Set the buffer hi
228F 58       01193         LD      E,B             ;Set the exact HIT lo
2290 21C622   01194         LD      HL,NAME$EXT     ;This doesn't change C
2293 CD1E1E   01195         CALL    HASHNAME        ;Hash the new name
2296 12       01196         LD      (DE),A          ;Stuff code into HIT
2297 C39818   01197         JP      @HITWR          ;Rewrite & exit
              01198 ;
              01199 ;       Routine to rename a device
              01200 ;
229A E5       01201 RENDEV  PUSH    HL              ;Save new pointer
229B CD591E   01202         CALL    GETDCB          ;Locate old in tables
229E DDE1     01203         POP     IX              ;Recover pointer to "new"
22A0 C0       01204         RET     NZ              ;Back if not in tables
22A1 7D       01205         LD      A,L
22A2 FE31     01206         CP      DCBKL$          ;Ck if protected device
22A4 3E28     01207         LD      A,40            ;"Protected system device
22A6 D8       01208         RET     C
22A7 DD7E00   01209         LD      A,(IX+0)        ;"new" must be a device
22AA FE2A     01210         CP      '*'
22AC 20BF     01211         JR      NZ,REN3A        ;"illegal file name...
22AE E5       01212         PUSH    HL              ;Save address of "old"
22AF CD591E   01213         CALL    GETDCB          ;Ck if "new" is unused
22B2 E1       01214         POP     HL              ;Rcvr address of "old"
22B3 28B8     01215         JR      Z,REN3A
22B5 010600   01216         LD      BC,6            ;Point to name field
22B8 09       01217         ADD     HL,BC           ;  of "old" device
22B9 73       01218         LD      (HL),E          ;Stuff new name into
22BA 23       01219         INC     HL              ;  device control block
22BB 72       01220         LD      (HL),D
22BC AF       01221         XOR     A               ;Set Z-flag
22BD C9       01222         RET
              01223 ;
              01224 ;       Parameter storage area
              01225 ;
              01226         IF      @BLD631
              01227         ELSE
              01228 FILEHASH        DS      1
              01229         ENDIF
22BE          01230 PSWDBUF         DS      8
22C6          01231 NAME$EXT        DS      8
22CE          01232 FILE$EXT        DS      3
22D1          01233 PW$HASH1        DS      2
22D3          01234 PW$HASH2        DS      2
22D5 0000     01235         DW      0               ;ERN init
22D7 00       01236 DIR$INIT        DB      0,0,0,0
     00 00 00 
              01237         IF      @BLD631
22DB          01238 LAST    EQU     $
22DB          01239 LREC$   DS      1                       ;<631>
22DC          01240 FILEHASH        DS      1               ;<631>
              01241         ELSE
              01242 LREC$   DS      1
              01243 LAST    EQU     $
              01244         ENDIF
              01245         IFGT    $,DIRBUF$
              01246         ERR     'Module too big'
              01247         ENDIF
23FE          01248         ORG     MAXCOR$-2
23FE DB04     01249         DW      LAST-SYS2       ;Overlay length
              01250 ;
1E00          01251         END     SYS2
1E00 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]

Valid HTML 4.01!