home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / zsus / zsus009.lbr / DSKNUM14.LBR / DSKNUM14.MZC / DSKNUM14.MAC
Text File  |  1990-07-28  |  18KB  |  685 lines
  1. ; DSKNUM.MAC  (formerly DISKNUM.MAC)
  2. ;
  3. Vers    equ    14
  4. SubVers    equ    ' '        ; revision level
  5. ;
  6. ; A ZCPR33+ utility to create null disk labels.
  7. ;
  8. ; USAGE:
  9. ;
  10. ;    DSKNUM {dir:}{label}{.num} {{/}options}
  11. ;
  12. ; If a DIR or DU specification is not given, the current drive and/or
  13. ; user is assumed, unless an internal default user is installed.  If
  14. ; no label name is given, an internal default is used.  If no disk
  15. ; number is given, the internal next number is used.  If no option is
  16. ; given, DSKNUM labels a single disk and exits.  By default DSKNUM
  17. ; saves the last number used internally, so you won't have to remember
  18. ; what it was.
  19. ;
  20. ; OPTIONS:  Slash not required if option is second token.
  21. ;
  22. ;    M    Multiple label mode.
  23. ;
  24. ;    S    Do not save last disk number.
  25. ;
  26. ; Numerous configuration options are available in the first sector of
  27. ; the program COM file.  See documentation for more information.
  28. ;
  29. ; Let me know if there are any problems.
  30. ;
  31. ;     Gene Pizzetta
  32. ;    481 Revere Street
  33. ;    Revere, MA  02151
  34. ;
  35. ;    Voice:  (617) 284-0891
  36. ;    Newton Centre Z-Node:  (617) 965-7259
  37. ;    GEnie:  E.Pizzetta
  38. ;
  39. ; Version 1.4 -- July 28, 1990 -- Gene Pizzetta
  40. ;    Complete rewrite.  Requires ZCPR 3.3 or higher.  Name changed to
  41. ;    DSKNUM from DISKNUM.  Labels a single disk from command line.
  42. ;    Still labels multiple disk interactively.  Accepts label name
  43. ;    from command line in lieu of internal default label name.  Accepts
  44. ;    disk number from command line in lieu of internal stored number.
  45. ;    Label attributes configurable.  Gets its own filename and directory
  46. ;    location from external file control block on first invocation.
  47. ;    Name is stored for subsequent execution with GO command.  Has
  48. ;    type 3 header.  Resets only target disk instead of entire disk
  49. ;    system under Z3PLUS and ZSDOS.  Configurable to reset disk or not
  50. ;    when saving last number internally (resets not needed for hard
  51. ;    drives).  Accepts target user area from command line or configurable
  52. ;    to use internal default user.  Aborts if label already exists on disk.
  53. ;    Sets ZCPR3 error flag if an invalid DU is given (2), if the disk
  54. ;    number exceeds 999 (9), if the disk is out of directory space (11),
  55. ;    if a label already exists on the disk (16), if an invalid option
  56. ;    is given (19), or any other error (4).  ^C aborts to operating
  57. ;    system at any prompt.  Brief usage screen if "//" is given.
  58. ;    Configurable with ZCNFG 1.6 or higher.
  59. ;
  60. ; Version 1.3 -- March 3, 1989 -- Gene Pizzetta
  61. ;    Minor bug correction.
  62. ;
  63. ; Version 1.2 -- February 28, 1989 -- Gene Pizzetta
  64. ;    Corrected several file handling problems in CP/M 2.2 version.
  65. ;    Added user area support.
  66. ;
  67. ; Version 1.1 -- December 26, 1987 -- Gene Pizzetta
  68. ;    Added CP/M 2.2 support.
  69. ;
  70. ; Version 1.0 -- December 24, 1987 -- Gene Pizzetta
  71. ;    Original release for CP/M-Plus.
  72. ;
  73. ; Developed with SLRMAC and SLRNK+.
  74. ;
  75. ; System addresses . . .
  76. ;
  77. CpmFcb    equ    05Ch        ; default file control block
  78. CpmDma    equ    080h        ; default DMA buffer
  79. ;
  80. ; Character codes . . .
  81. ;
  82. CtrlC    equ    03h        ; ^C
  83. BEL    equ    07h        ; bell
  84. TAB    equ    09h        ; tab
  85. CR    equ    0Dh        ; carriage return
  86. LF    equ    0Ah        ; linefeed
  87. ESC    equ    1Bh        ; escape
  88. ;
  89. ; BDOS service functions . . .
  90. ;
  91. CpmVer    equ    12        ; CP/M version request
  92. ResSys    equ    13        ; reset disk system
  93. FSrchF    equ    17        ; search for first match
  94. SetAtt    equ    30        ; set file attributes
  95. ResDrv    equ    37        ; reset individual drives
  96. DosVer    equ    48        ; ZRDOS, ZSDOS version request
  97. ;
  98.     MACLIB    Z80        ; this is extended Intel
  99. ;
  100. ; Routines from VLIB, Z3LIB, and SYSLIB . . .
  101. ;
  102.     ext    bdos,epstr,crlf,pafdc,cout,cin,isdigit,comphd,eval10,phl4hc
  103.     ext    retud,logud,initfcb,setdma,f$open,f$mopen,f$close,r$write
  104.     ext    zsyschk,z33chk,z3vinit,gzmtop,tinit,dinit,getefcb,pfn1
  105.     ext    prtname,puter2
  106.     ext    stndout,stndend
  107. ;
  108. ; TYP3HDR.MAC, Version 1.1  --  Extended Intel Mnemonics
  109. ; This code has been modified as suggested by Charles Irvine so that
  110. ; it will function correctly with interrupts enabled.
  111. ; Extended Intel mnemonics by Gene Pizzetta, April 30, 1989.
  112. ;
  113. Entry:    jr    Start0        ; must use relative jump
  114.     db    0        ; filler
  115.     db    'Z3ENV',3    ; type-3 environment
  116. Z3EAdr:    dw    0FE00h        ; filled in by Z33
  117.     dw    Entry        ; intended load address
  118. ;
  119. ; Configuration area . . .
  120. ;
  121.     db    'DSKNUM'    ; default name for CFG file
  122.     db    Vers/10+'0',Vers mod 10+'0'    ; version for CFG file
  123.     db    'ROFLG>'    ; set read-only attribute in label
  124. ROFlg    db    0        ; ..0 = no, non-zero = yes
  125.     db    'SYSFLG>'    ; set system attribute in label
  126. SysFlg:    db    0        ; ..0 = no, non-zero = yes
  127.     db    'ARCFLG>'    ; set archive attribute in label
  128. ArcFlg:    db    0        ; ..0 = no, non-zero = yes
  129.     db    'RSTFLG>'    ; reset drive before saving number
  130. RstFlg:    db    0        ; ..0 = no, non-zero = yes
  131.     db    'LBLTAG>'    ; first character of label
  132. LblTag:    db    '#'        ; "!" or "#" recommended
  133.     db    'DFTLBL>'    ; default disk label, if not given
  134. DftLbl:    db    'DISK   <'    ; ..(7 upper-case characters)
  135.     db    'LBLUSR>'    ; user area for label, or FF to use
  136. LblUsr:    db    0FFh        ; ..current or given user
  137. LstNum:    dw    0        ; last number written to disk
  138. ;
  139. Start0:    lxi    h,0        ; point to warmboot entry
  140.     mov    a,m        ; save the byte there
  141.     di            ; protect against interrupts
  142.     mvi    m,0C9h        ; replace warmboot with a return opcode
  143.     rst    0        ; call address 0, pushing RetAddr onto stack
  144. RetAddr:
  145.     mov    m,a        ; restore byte at 0
  146.     dcx    sp        ; get stack pointer to point
  147.     dcx    sp        ; ..to the value of RetAddr
  148.     pop    h        ; get it into HL and restore stack
  149.     ei            ; we can allow interrupts again
  150.     lxi    d,RetAddr    ; this is where we should be
  151.     xra    a        ; clear carry flag
  152.     push    h        ; save address again
  153.     dsbc    de        ; subtract -- we should have 0 now
  154.     pop    h        ; restore value of RetAddr
  155.     jz    Start        ; if addresses matched, begin real code
  156. ;
  157.     lxi    d,NotZ33Msg-RetAddr ; offset to message
  158.     dad    d
  159.     xchg            ; switch pointer to message into DE
  160.     mvi    c,9
  161.     jmp    0005h        ; return via BDOS print string function
  162. ;
  163. NotZ33Msg:
  164.     db    'Not Z33+$'    ; abort message if not Z33-compatible
  165. ;
  166. ; Messages . . .
  167. ;
  168. MsgUse:    db    'DSKNUM    Version '
  169.     db    Vers/10+'0','.',Vers mod 10+'0',SubVers
  170.     db    '  (loaded at ',0
  171. MsgUs1:    db    'h)',CR,LF
  172.     db    'Usage:',CR,LF,'   ',0
  173. MsgUs2:    db    ' {dir:}{label}{.num} {{/}options}',CR,LF
  174.     db    'Options:',CR,LF
  175.     db    '   M   Multiple label mode',CR,LF
  176.     db    '   S   Don''t save last number',0
  177. MsgNxt:    db    'Next Label: ',0
  178. MsgDot:    db    ' .. ',0
  179. MsgDsk:    db    ' .. Press any key (ESC = Quit) .. ',0
  180. MsgRng:    db    BEL,'Next number out of range',0
  181. MsgBad:    db    BEL,'Bad disk number',0
  182. MsgIOp:    db    BEL,'Invalid option',0
  183. MsgExs:    db    BEL,'Label exists',0
  184. MsgFDr:    db    BEL,'No directory space',0
  185. MsgIDr:    db    BEL,'Invalid directory',0
  186. MsgWEr:    db    BEL,'File write error, ',0
  187. MsgNSv:    db    'Not saved',0
  188. MsgZ33:    db    BEL,'ZCPR33+ required',0
  189. MsgPrg:    db    BEL,'Can''t find ',0
  190. MsgAgn:    db    ' .. Any key to try again .. ',0
  191. MsgAbt:    db    'Aborted',0
  192. MsgDne:    db    'Saved',0
  193. ;
  194. ; Start of program . . .
  195. ;
  196. Start:    lhld    Z3EAdr
  197.     call    z3vinit
  198.     call    z33chk        ; check for ZCPR33+
  199.     lxi    h,MsgZ33
  200.     jnz    epstr        ; (it's not)
  201.     sspd    OldStk        ; save old stack pointer
  202.     lxi    h,OldStk
  203.     sphl            ; ..and set up new stack
  204. ;
  205.     lda    PrgNam        ; is this a rerun?
  206.     cpi    ' '
  207.     jrnz    Start1        ; (yes, it is)
  208.     call    getefcb        ; get external FCB address
  209.     inx    h        ; increment it to filename (EFCB+1)
  210.     lxi    d,PrgNam    ; ..and move program name to storage
  211.     lxi    b,11
  212.     ldir
  213.     inx    h        ; point to program user (EFCB+13)
  214.     mov    a,m        ; ..and move to storage
  215.     sta    PrgUsr
  216.     inx    h        ; point to program drive (EFCB+14)
  217.     mov    a,m        ; move program drive to storage
  218.     dcr    a        ; make A=0
  219.     sta    PrgDrv
  220. Start1:    call    ScanOp        ; scan for options
  221.     lda    CpmFcb+15    ; valid directory?
  222.     ora    a
  223.     jrz    Skip1
  224.     mvi    a,2        ; set error code (invalid directory)
  225.     sta    ErCode
  226.     lxi    h,MsgIDr
  227.     jmp    Exit        ; (nope)
  228. Skip1:    call    tinit        ; initialize terminal
  229.     call    retud        ; get default DU
  230.     mov    a,b        ; store drive
  231.     sta    TgtDrv
  232.     lda    CpmFcb        ; get drive, if any
  233.     ora    a
  234.     jrz    Start2        ; (no drive, use default)
  235.     dcr    a
  236.     sta    TgtDrv
  237. Start2:    lda    LblUsr        ; check for default user
  238.     cpi    32
  239.     jrc    Start3
  240.     lda    CpmFcb+13    ; get user
  241. Start3:    sta    TgtUsr
  242.     mov    c,a        ; put user in C
  243.     lda    TgtDrv        ; put drive in B
  244.     mov    b,a
  245.     call    logud        ; log into target DU
  246.     lda    LblTag        ; move label tag to FCB
  247.     sta    LblFcb+1
  248.     lxi    h,CpmFcb+1    ; check for filename (label)
  249.     mov    a,m
  250.     cpi    ' '
  251.     jrz    Start4        ; (none, use default)
  252.     cpi    '/'
  253.     jrz    Start4
  254.     mov    b,a        ; see if tag was given
  255.     lda    LblTag
  256.     cmp    b
  257.     jrnz    Start5        ; (no)
  258.     inx    h        ; point past tag
  259.     jr    Start5
  260. Start4:    lxi    h,DftLbl    ; move default disk label to FCB
  261. Start5:    lxi    d,LblFcb+2
  262.     lxi    b,7
  263.     ldir
  264.     lxi    h,CpmFcb+9    ; check for filetype (number)
  265.     mov    a,m
  266.     cpi    ' '
  267.     jrz    Start6        ; (none, use default)
  268.     call    isdigit
  269.     jrnz    BadNum        ; (not a digit, so abort)
  270.     call    eval10        ; get number
  271.     mov    a,m        ; get terminating character
  272.     xchg            ; move from DE to HL
  273.     ora    a        ; was character a null?
  274.     jrz    Start7        ; (yes, okay)
  275.     cpi    ' '        ; a space?
  276.     jrz    Start7        ; (okay, too)
  277. BadNum:    mvi    a,9        ; it's a bad number
  278.     sta    ErCode
  279.     lxi    h,MsgBad
  280.     jmp    Exit
  281. ;
  282. Start6:    lhld    LstNum        ; get last number
  283.     call    NumChk
  284.     inx    h        ; increment it
  285. Start7:    shld    CurNum        ; save it as current number
  286.     lxi    d,LblFcb+9    ; insert it into FCB
  287.     call    mhl3dc
  288.     lda    OpMFlg        ; check for mode
  289.     ora    a
  290.     jrnz    MMode        ; (multiple label mode)
  291. ;
  292. ; Single label module . . .
  293. ;
  294.     call    PrtNxt        ; print next label
  295.     lxi    h,MsgDot
  296.     call    epstr
  297.     call    DskRst        ; reset disk
  298.     call    ChkDup        ; labelled already?
  299.     jnz    Exit        ; (yep)
  300.     call    MakFil        ; create label
  301.     jnz    Exit        ; (space error)
  302.     call    FilAtt        ; set attributes
  303.     lda    OpSFlg        ; do we save last number?
  304.     ora    a
  305.     jrnz    NoSave        ; (no)
  306.     lhld    CurNum        ; get last label number used
  307.     shld    LstNum        ; ..and store in data sector
  308.     call    DskSav        ; save last number
  309.     jmp    Finish
  310. ;
  311. ; Multiple label module . . .
  312. ;
  313. MMode0:    call    crlf
  314. MMode:    call    PrtNxt        ; print next label
  315.     lxi    h,MsgDsk    ; press any key ...
  316.     call    AskOpr
  317.     cpi    ESC        ; quitting?
  318.     jrz    MMode1        ; (yes)
  319.     call    DskRst        ; reset disk
  320.     call    ChkDup        ; labelled already?
  321.     cnz    epstr
  322.     jnz    MMode0        ; (yep)
  323.     call    MakFil        ; create label
  324.     cnz    epstr
  325.     jnz    MMode0
  326.     call    FilAtt
  327.     lhld    CurNum        ; get last label number used
  328.     shld    LstNum        ; ..and store in data sector
  329.     call    NumChk
  330.     inx    h        ; increment it
  331.     shld    CurNum        ; save it as current number
  332.     lxi    d,LblFcb+9    ; insert it into FCB
  333.     call    mhl3dc
  334.     jr    MMode0        ; ..and loop
  335. ;
  336. MMode1:    lda    OpSFlg        ; are we saving number?
  337.     ora    a
  338.     jrnz    NoSave        ; (no)
  339.     call    DskSav        ; yes, go do it
  340.     jmp    Finish
  341. ;
  342. ; Common exit routines . . .
  343. ;
  344. NoSave:    lxi    h,MsgNSv
  345.     jr    Exit
  346. ;
  347. Finish:    lxi    h,MsgDne
  348.     jr    Exit
  349. ;
  350. Abort:    lxi    h,MsgAbt
  351.     mvi    a,4        ; set error code
  352.     sta    ErCode
  353. Exit:    call    epstr
  354.     call    dinit        ; clear terminal
  355.     lda    ErCode
  356.     call    puter2
  357.     lspd    OldStk
  358.     ret
  359. ;
  360. ; Subroutines . . .
  361. ;
  362. ; DskSav -- Save data sector to disk.
  363. ;
  364. DskSav:    call    DskRs0        ; reset disk system
  365.     lxi    h,PrgNam    ; put program name in FCB
  366.     lxi    d,LblFcb+1
  367.     lxi    b,11
  368.     ldir
  369.     lda    PrgDrv        ; log into program DU
  370.     mov    b,a
  371.     lda    PrgUsr
  372.     mov    c,a
  373.     call    logud
  374. DskSv1:    lda    RstFlg        ; do we reset drive?
  375.     ora    a
  376.     cnz    DskRst        ; (yes)
  377.     lxi    d,LblFcb
  378.     call    initfcb
  379.     call    f$open        ; open ourselves
  380.     jrnz    GetDsk        ; we can't find ourselves
  381. ;
  382.     lxi    h,Entry        ; set dma address to our 1st record
  383.     call    setdma
  384.     lxi    h,0        ; set record number
  385.     call    r$write        ; write record
  386.     jrnz    DskErr        ; (error)
  387.     call    f$close        ; close file
  388.     ret
  389. ;
  390. GetDsk:    call    crlf
  391.     lxi    h,MsgPrg    ; request program disk
  392.     call    PrtNx1
  393.     lxi    h,MsgAgn
  394.     call    AskOpr
  395.     jr    DskSv1        ; ..and try again
  396. ;
  397. DskErr:    call    crlf
  398.     lxi    h,MsgWEr    ; file write error
  399.     call    epstr
  400.     jmp    Abort
  401. ;
  402. ; FilAtt -- Sets label attributes based on configuration bytes.
  403. ;
  404. FilAtt:    lda    ROFlg        ; check read-only flag
  405.     ora    a
  406.     jrz    FilAt1        ; (no, skip read-only)
  407.     lda    LblFcb+9    ; set read-only attribute
  408.     ori    80h        ; ..Read Only
  409.     sta    LblFcb+9
  410. FilAt1:    lda    SysFlg        ; check system flag
  411.     ora    a
  412.     jrz    FilAt2        ; (no, skip system)
  413.     lda    LblFcb+10    ; set system attribute
  414.     ori    80h
  415.     sta    LblFcb+10
  416. FilAt2:    lda    ArcFlg        ; check archive flag
  417.     ora    a
  418.     jrz    FilAt3        ; (no, skip archive)
  419.     lda    LblFcb+11    ; set archive attribute
  420.     ori    80h
  421.     sta    LblFcb+11
  422. FilAt3:    lxi    d,LblFcb
  423.     mvi    c,SetAtt
  424.     call    bdos
  425.     ret
  426. ;
  427. ; DskRst -- resets current drive only under ZSDOS and CP/M-Plus;
  428. ; otherwise, resets disk system.  (Based on Carson Wilson's RCPR v1.5
  429. ; for Z34RCP.)
  430. ;
  431. DskRst:    mvi    c,CpmVer    ; get CP/M version
  432.     call    bdos
  433.     cpi    30h        ; CP/M Plus?
  434.     jrnc    DskRs1        ; (yes)
  435.     mvi    c,DosVer
  436.     call    bdos        ; ZRDOS or CP/M?
  437.     mov    a,h
  438.     ora    a
  439.     jrnz    DskRs1        ; (no, assume function 37 is bug-free
  440. DskRs0:    mvi    c,ResSys    ; reset disk system
  441.     call    bdos
  442.     ret
  443. ; reset single drive
  444. DskRs1:    call    retud        ; get current drive
  445.     mov    a,b        ; put it in A
  446.     inr    a        ; shift range to 1..16
  447.     lxi    h,1        ; map drive "A:"    
  448. DskRs3:    dcr    a        ; done yet?
  449.     jrz    DskRs4        ; (yes)
  450.     dad    h        ; shift vector to next drive
  451.     jr    DskRs3
  452. DskRs4:    xchg            ; put vector in DE
  453.     mvi    c,ResDrv    ; reset single drive
  454.     call    bdos
  455.     ret
  456. ;
  457. ; MakFil -- create, open, and close a zero-length file.  Return
  458. ; Z if okay, NZ if no directory space.
  459. ;
  460. MakFil:    lxi    d,LblFcb
  461.     call    initfcb
  462.     call    f$mopen        ; create and open file
  463.     jrnz    MakFi1        ; (no directory space)
  464.     call    f$close        ; close file
  465.     ret
  466. ;
  467. MakFi1:    mvi    a,11        ; set error code (directory full)
  468.     sta    ErCode
  469.     lxi    h,MsgFDr
  470.     ret
  471. ;
  472. ; ChkDup -- checks for an existing filename beginning with the
  473. ; tag character.  Returns Z if not found, NZ if found.
  474. ;
  475. ChkDup:    lda    LblTag        ; stuff label tag into FCB
  476.     sta    CpmFcb+1
  477.     lxi    h,WildNm    ; fill rest with ?'s
  478.     lxi    d,CpmFcb+2
  479.     lxi    b,10
  480.     ldir
  481.     lxi    d,CpmFcb
  482.     call    initfcb
  483.     mvi    c,FSrchF    ; does it exist?
  484.     call    bdos
  485.     inr    a
  486.     rz
  487.     mvi    a,16        ; set error code (duplicate filespec ?!?)
  488.     sta    ErCode
  489.     lxi    h,MsgExs    ; say label exists
  490.     ret
  491. ;
  492. ; ScanOp -- scan command line for options
  493. ;
  494. ScanOp:    xra    a        ; initialize option flags
  495.     sta    OpMFlg
  496.     sta    OpSFlg
  497.     sta    ErCode        ; ..and error code
  498.     lxi    h,CpmDma+1    ; point to command line
  499.     call    EatSpc        ; jump past spaces
  500.     inx    h
  501.     ora    a
  502.     rz            ; (no more)
  503.     cpi    '/'        ; option flag?
  504.     jrz    GetOpt        ; (yes)
  505. ScanO1:    mov    a,m        ; get past filespec
  506.     inx    h
  507.     ora    a
  508.     rz            ; (no more)
  509.     cpi    ' '
  510.     jrz    ScanO2
  511.     cpi    TAB
  512.     jrnz    ScanO1
  513. ScanO2:    call    EatSpc
  514.     ora    a
  515.     rz            ; (no more)
  516.     cpi    '/'
  517.     jrnz    GetOpt
  518.     inx    h
  519. ;
  520. GetOpt:    mov    a,m        ; get option
  521.     ora    a
  522.     rz            ; (no more)
  523.     cpi    '/'        ; help request?
  524.     jrz    Usage
  525.     cpi    'M'
  526.     jrz    SetMOp
  527.     cpi    'S'
  528.     jrz    SetSOp
  529.     inx    h
  530.     cpi    ' '
  531.     jrz    GetOpt
  532.     mvi    a,19        ; set error code (invalid option)
  533.     sta    ErCode
  534.     lxi    h,MsgIOp
  535.     jmp    Exit
  536. ;
  537. SetMOp:    mvi    a,0FFh
  538.     sta    OpMFlg
  539.     inx    h
  540.     jr    GetOpt
  541. ;
  542. SetSOp:    mvi    a,0FFh
  543.     sta    OpSFlg
  544.     inx    h
  545.     jr    GetOpt
  546. ;
  547. Usage:    lxi    h,MsgUse    ; print usage message
  548.     call    epstr
  549.     lxi    h,Entry        ; print load address
  550.     call    phl4hc
  551.     lxi    h,MsgUs1
  552.     call    epstr
  553.     call    prtname
  554.     lxi    h,MsgUs2
  555.     jmp    Exit
  556. ;
  557. ; EatSpc -- Gobbles up spaces and tabs
  558. ;
  559. EatSpc:    mov    a,m
  560.     inx    h
  561.     cpi    ' '        ; is it a space?
  562.     jrz    EatSpc        ; (yes)
  563.     cpi    TAB        ; it it a tab?
  564.     jrz    EatSpc        ; (yes)
  565.     dcx    h
  566.     ret
  567. ;
  568. ; AskOpr -- get response from user
  569. ;
  570. AskOpr:    call    epstr
  571.     call    cin        ; wait for character
  572.     cpi    CtrlC        ; ^C ?
  573.     rnz            ; (nope)
  574.     jmp    Abort
  575. ;
  576. ; MHL3DC -- Store HL as 3 decimal characters in 3-byte memory buffer
  577. ; pointed to by DE (based on Carson Wilson's SMHL5DC+ module in ZSLIB 2.1).  
  578. ;
  579. MHL3DC:    push    psw        ; save regs
  580.     push    b
  581.     push    h
  582.     pushix
  583.     push    d        ; for output
  584.     popix
  585.     mvi    b,0        ; B=0 for no leading spaces
  586.     lxi    d,100        ; store 100's
  587.     call    MHDC1
  588. MHDC6:    lxi    d,10        ; store 10's
  589.     call    MHDC1
  590.     mov    a,l        ; store 1's
  591.     adi    '0'        ; convert to ASCII
  592.     call    MHDC8
  593.     popix            ; restore regs
  594.     pop    h
  595.     pop    b
  596.     pop    psw
  597.     ret
  598. ;
  599. ;  Divide HL by DE and store quotient with leading spaces
  600. ;
  601. MHDC1:    xra    a        ; set count
  602. MHDC2:    ora    a        ; clear carry
  603.      dsbc    de
  604.     jrc    MHDC3        ; done if carry set (further borrow)
  605.     inr    a        ; increment count
  606.     jr    MHDC2
  607. MHDC3:    dad    d
  608.     ana    a        ; check for zero
  609.     jrnz    MHDC4
  610.     ora    b        ; 0 = no leading spaces (A=0, A or B = 0 if B=0)
  611.     jrz    MHDC4
  612.     mvi    a,' '        ; store space
  613.     jr    MHDC8
  614. MHDC4:    mvi    b,0        ; turn off leading spaces for rest of output
  615. MHDC7:    adi    '0'        ; convert to ASCII
  616. MHDC8:    pushix            ; get storage address
  617.     pop    d
  618.     inxix
  619.     call    MOUT
  620.     ret
  621. ;
  622. ; MOUT - Store A to memory at DE (from Carson Wilson's ZSLIB 2.1)
  623. ;    Entry:     A = value to store
  624. ;        DE = address of memory buffer (1 byte)
  625. ;    Exit:    DE = address of byte after output
  626. ;    Uses:    DE
  627. ;
  628. MOUT:    stax    d
  629.     inx    d
  630.     ret
  631. ;
  632. ; NumChk -- checks if number is 999 and, if so, aborts.
  633. ;
  634. NumChk:    lxi    d,999
  635.     call    comphd
  636.     rc
  637.     lda    OpMFlg        ; check mode
  638.     ora    a
  639.     cnz    crlf
  640.     mvi    a,9        ; set error code (bad numerical expression)
  641.     sta    ErCode
  642.     lxi    h,MsgRng
  643.     jmp    Exit
  644. ;
  645. ; PrtNxt -- Print next disk label
  646. ;
  647. PrtNxt:    lxi    h,MsgNxt    ; report next label
  648. PrtNx1:    call    epstr
  649.     call    stndout
  650.     call    retud        ; get current DU
  651.     mov    a,b        ; put drive in A
  652.     adi    'A'        ; make it printable
  653.     call    cout
  654.     mov    a,c        ; put user in A
  655.     call    pafdc
  656.     mvi    a,':'        ; print colon
  657.     call    cout
  658.     lxi    d,LblFcb+1    ; print label
  659.     call    pfn1
  660.     call    stndend
  661.     ret
  662. ;
  663. ; Data . . .
  664. ;
  665. PrgNam:    db    '           '    ; program name storage
  666. PrgDrv:    db    0        ; program drive location
  667. PrgUsr:    db    0        ; program user location
  668. WildNm:    db    '??????????'    ; for existence test
  669. ;
  670. ; Uninitialized data . . .
  671. ;
  672.     DSEG
  673. ;
  674. OpMFlg:    ds    1        ; non-zero = option M (multiple labels)
  675. OpSFlg:    ds    1        ; non-zero = option S (don't save)
  676. CurNum:    ds    2        ; current label number
  677. TgtDrv:    ds    1        ; default drive
  678. TgtUsr:    ds    1        ; default user
  679. ErCode:    ds    1        ; error code
  680.     ds    50        ; stack
  681. OldStk:    ds    2        ; stack pointer storage
  682. LblFcb:    ds    36        ; label file control block
  683. ;
  684.     end
  685.