home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / packet / rli120.ark / MISC.MAC < prev    next >
Encoding:
Text File  |  1987-05-12  |  10.0 KB  |  587 lines
  1. ; MISC.MAC - 5/11/87 - Misc routines.
  2.  
  3.     .z80
  4.     .xlist
  5.     maclib    TNC.LIB
  6.     asciictl
  7.     tncdefs
  8.     timdef
  9.     .list
  10.  
  11.     entry    settim,curtime,date,time,ynbq
  12.     entry    primet,tm1,tm2,tm3,tm4,tm5
  13.  
  14.     external    cmd,cmdlen,@prtx,fcb1,fcb2,getcmd
  15.     external    erwhat
  16.  
  17.     dseg
  18. date:    ds    6
  19. time:    ds    6
  20. primet:    ds    3    ;24 bits, which are primetime hours
  21.  
  22.     cseg
  23.  
  24. twodig    macro    addr
  25.     local    tda
  26.     call    bindec
  27.     ld    a,(numb+3)
  28.     cp    ' '
  29.     jr    nz,tda
  30.     ld    a,'0'
  31. tda:    ld    (addr),a
  32.     movb    addr+1,numb+4
  33.     endm
  34.  
  35. ; Place current date/time into DATE and TIME in ascii.
  36.  
  37. curtime:    ld    h,0
  38.     di
  39.     ld    a,(sec)
  40.     ld    l,a
  41.     push    hl
  42.     ld    a,(min)
  43.     ld    l,a
  44.     push    hl
  45.     ld    a,(hr)
  46.     ld    l,a
  47.     push    hl
  48.     ld    a,(day)
  49.     ld    l,a
  50.     push    hl
  51.     ld    a,(mo)
  52.     ld    l,a
  53.     push    hl
  54.     ld    a,(yr)
  55.     ei
  56.     ld    l,a
  57.     twodig    date
  58.     pop    hl
  59.     twodig    date+2
  60.     pop    hl
  61.     twodig    date+4
  62.     pop    hl
  63.     twodig    time
  64.     pop    hl
  65.     twodig    time+2
  66.     pop    hl
  67.     twodig    time+4
  68.     ret
  69.  
  70. ; Decide if a timed param is on or off
  71. ; Call with A/ one of TRUE, FALSE, BTIME or QTIME
  72. ; Return with A/ 0 or FF (false or true) and Z flag to match
  73.  
  74. ynbq:    or    a        ; Called with FALSE?
  75.     ret    z        ; Return false if so
  76.     cp    btime        ; Called with BTIME?
  77.     jr z,    ynbqb        ; If so, see if busy time
  78.     cp    qtime        ; Called qith QTIME?
  79.     jr z,    ynbqq        ; If so, see if quiet time
  80. ynbqnz:    xor    a        ; Return TRUE and NZ flag
  81.     dec    a
  82.     ret
  83.  
  84. ynbqq:    call    ynbqb        ; Quiet is complement of busy
  85.     cpl
  86.     or    a
  87.     ret
  88.  
  89. ynbqb:    ld hl,    primet        ; Point at 0000-0759 bits
  90.     ld a,    (hr)        ; Pick up the hour
  91. ynbq1:    sub    8        ; Is it 0-7?
  92.     jr c,    ynbq2        ; Go if found right 8 hrs
  93.     inc    hl        ; Step to next 8 hours
  94.     jr    ynbq1        ; Will break within 3 loops, 32 if hr nuts
  95.  
  96. ynbq2:    ld c,    (hl)        ; Pick up the 8 hours
  97.     and    7        ; Mask 0-7 for bit in this byte
  98. ynbq3:    rl    c        ; Shift bit into CY
  99.     dec    a        ; Right bit yet?
  100.     jp p,    ynbq3        ; Loop, up to 8 times, for right bit
  101.     jr c,    ynbqnz        ; If bit is 1, return NZ
  102.     xor    a        ; If bit is 0, return Z
  103.     ret
  104.  
  105.  
  106. ; Set current date and time.
  107.  
  108.     dseg
  109. tm1:    ds    2
  110. tm2:    ds    2
  111. tm3:    ds    2
  112. tm4:    ds    2
  113. tm5:    ds    2
  114.  
  115.     cseg
  116. getnum:    call    getcmd
  117.     move    numb,fcb1+1,5
  118.     call    decbin
  119.     ld    a,l
  120.     ret
  121.  
  122. settim:    prtx    tm1
  123.     call    getnum
  124.     push    af
  125.     prtx    tm2
  126.     call    getnum
  127.     push    af
  128.     prtx    tm3
  129.     call    getnum
  130.     push    af
  131.  
  132. ; Get the current time.
  133.  
  134.     prtx    tm4
  135.     call    getnum
  136.     push    af
  137.     prtx    tm5
  138.     call    getnum
  139.     di
  140.     ld    (min),a
  141.     pop    af
  142.     ld    (hr),a
  143.     mvim    sec,0
  144.     pop    af
  145.     ld    (day),a
  146.     pop    af
  147.     ld    (mo),a
  148.     pop    af
  149.     ld    (yr),a
  150.     ei
  151.     ret
  152.  
  153. ; (A) to upper case.
  154.  
  155.     entry    ucase
  156. ucase:    cp    'a'
  157.     ret    c
  158.     cp    'z'+1
  159.     ret    nc
  160.     and    5fh
  161.     ret
  162.  
  163.     entry    @upper
  164. @upper:    ld    a,(hl)
  165.     call    ucase
  166.     ld    (hl),a
  167.     inc    hl
  168.     dec    c
  169.     jr    nz,@upper
  170.     ret
  171.  
  172. ; Compare string at (de) with string in command buffer for (c) chars.
  173. ; Return zero set if match.
  174.  
  175.     entry    @cmpcmd
  176. @cmpcmd:    ld    a,(cmdlen)
  177.     cp    c
  178.     ret    c
  179.     ld    hl,cmd
  180.  
  181. ; Compare string at (de) with string at (hl) for (c) chars.
  182. ; Return zero set if match.
  183.  
  184.     entry    @cmp
  185. @cmp:    ld    a,(de)
  186.     cp    (hl)
  187.     ret    nz
  188.     inc    hl
  189.     inc    de
  190.     dec    c
  191.     ret    z
  192.     jr    @cmp
  193.  
  194. ; As above, but with wildcards allowed in the string at (de).
  195. ; "*" means match rest of item, "?" means match this one character.
  196.  
  197.     entry    @cmpwc
  198. @cmpwc:    ld    a,(de)
  199.     cp    '*'
  200.     ret    z        ; Star says it all matches
  201.     cp    '?'        ; Question mark matches any 1 char
  202.     jr z,    cmpwc1
  203.     cp    (hl)
  204.     ret    nz
  205. cmpwc1:    inc    hl
  206.     inc    de
  207.     dec    c
  208.     ret    z
  209.     jr    @cmpwc
  210.  
  211. ; Search a fixed width list.
  212. ; Return zero set if find.
  213. ; Return @srcl pointing to start of found item,
  214. ; or to item beyond current end of list.
  215. ; Return the number of the found record in @srcf.
  216. ; Enter with non-zero in A if wild cards allowed in target item.
  217.  
  218.     entry    @srct,@srcl,@srcn,@srcw,@srcc,@srcf,@src
  219.     dseg
  220. @srct:    ds    2        ; Target address
  221. @srcl:    ds    2        ; List address
  222. @srcn:    ds    2        ; # items in list
  223. @srcw:    ds    2        ; # bytes/item
  224. @srcc:    ds    2        ; # bytes to compare
  225. @srcf:    ds    2        ; Record number of found record
  226. @srcq:    ds    1        ; Non-zero if wildcards allowed
  227.  
  228.     cseg
  229. @src:    ld    (@srcq),a
  230.     lxim    @srcf,0
  231. @srca:    dtz    @srcn
  232.     jr    nz,@srcb
  233.     retnz            ; No find
  234. @srcb:    inxm    @srcf        ; Count the record
  235.     ld    de,(@srct)
  236.     ld    hl,(@srcl)
  237.     ld    a,(@srcc)
  238.     ld    c,a
  239.     ld    a,(@srcq)    ; See if wildcards allowed
  240.     or    a
  241.     jr    z,@src1
  242.     call    @cmpwc        ; If so, use different search routine
  243.     jr    @src2
  244.  
  245. @src1:    call    @cmp
  246. @src2:    ret    z        ; Return if matched
  247.     ld    de,(@srcw)
  248.     ld    hl,(@srcl)
  249.     add    hl,de
  250.     ld    (@srcl),hl
  251.     dcxm    @srcn
  252.     jr    @srca
  253.  
  254. ; Add or update an item to a time odered list.
  255.  
  256.     entry    @adll,@adlm,@adlw,@adln,@adlt,@adlc,@adl
  257.  
  258.     dseg
  259. @adll:    ds    2        ; Address of list
  260. @adlm:    ds    2        ; Max entries in list
  261. @adlw:    ds    2        ; Bytes per entry
  262. @adln:    ds    2        ; Items on list
  263. @adlt:    ds    2        ; Addres of item to add
  264. @adlc:    ds    2        ; Bytes to compare
  265.  
  266.     cseg
  267. @adl:    movw    @srct,@adlt
  268.     movw    @srcl,@adll
  269.     movw    @srcn,@adln
  270.     movw    @srcw,@adlw
  271.     movw    @srcc,@adlc
  272.     call    @src        ; Is it already on the list?
  273.     jr    z,adla        ; Yes
  274.     ld    de,(@adlm)
  275.     ld    hl,(@adln)
  276.     or    a        ; Clear carry
  277.     sbc    hl,de
  278.     jr    z,adla        ; List full
  279.     inxm    @adln        ; New count
  280. adla:    ld    de,(@adll)    ; Start of list
  281.     ld    hl,(@srcl)    ; Pointer to slot
  282.     or    a        ; Clear carry
  283.     sbc    hl,de        ; Put at top?
  284.     jr    z,adlc        ; Yes
  285.     ld    b,h
  286.     ld    c,l        ; (BC)=# bytes to move
  287.     ld    hl,(@srcl)    ; Start of slot
  288.     dec    hl        ; End of previous slot
  289.     ld    de,(@adlw)    ; Slot size
  290.     add    hl,de        ; End of this slot
  291.     ex    de,hl        ; (DE)=dest address
  292.     ld    hl,(@srcl)
  293.     dec    hl        ; (HL)=source address
  294. adlb:    ldd            ; Move byte
  295.     ld    a,c
  296.     or    b
  297.     jr    nz,adlb
  298. ; Move new item into list.
  299. adlc:    ld    hl,(@adlt)
  300.     ld    de,(@adll)
  301.     ld    bc,(@adlw)
  302.     ldir
  303.     ret
  304.  
  305. ; Return(HL) pointing to the oldest item in a list, remove item.
  306. ; Return zero set if no items.
  307.  
  308. ;    entry    @slst
  309. ;@slst:    dtz    @adln        ; List empty?
  310. ;    ret    z        ; Yes
  311. ;    dec    hl        ; One less item
  312. ;    ld    (@adln),hl
  313. ;    ex    de,hl
  314. ;    ld    bc,(@adlw)    ; Bytes/item
  315. ;    call    muldec
  316. ;    ld    hl,(@adll)    ; List start
  317. ;    add    hl,de
  318. ;    retnz
  319.  
  320. ; Move bytes from command line to (hl).
  321. ; Move at most (c) bytes, start (e) bytes from beginning.
  322.  
  323.     entry    @mcmd
  324. @mcmd:    ld    a,(cmdlen)
  325.     sub    e
  326.     cp    c
  327.     jr    nc,@mcme
  328.     ld    c,a
  329. @mcme:    ld    b,0
  330.     push    hl
  331.     ld    hl,cmd
  332.     add    hl,de
  333.     ex    de,hl
  334.     pop    hl
  335.  
  336. ; Move (bc) bytes from (de) to (hl). LDIR for 8080.
  337.  
  338.     entry    @move
  339. @move:    ld    a,b
  340.     or    c
  341.     ret    z
  342.     ld    a,(de)
  343.     ld    (hl),a
  344.     inc    hl
  345.     inc    de
  346.     dec    bc
  347.     jr    @move
  348.  
  349. ; move call from (HL) to (DE), (A) length of string at (HL).
  350. ; Ignore trailing "-x".
  351.  
  352.     entry    movcal
  353. movcal:    ld    c,a
  354.     cp    7
  355.     jr    c,@mca
  356.     ld    c,6
  357. @mca:    push    hl
  358.     push    de
  359.     push    bc
  360.     ex    de,hl
  361.     fill    ,6,' '
  362.     pop    bc
  363.     pop    de
  364.     pop    hl
  365. @mcb:    dec    c
  366.     ret    m
  367.     ld    a,(hl)
  368.     cp    ' '
  369.     ret    z
  370.     cp    '-'
  371.     ret    z
  372.     call    ucase
  373.     ld    (de),a
  374.     inc    hl
  375.     inc    de
  376.     jr    @mcb
  377.  
  378. ; Fill (bc) bytes at (hl) with (e).
  379.  
  380.     entry    @fill
  381. @fill:    ld    a,b
  382.     or    c
  383.     ret    z
  384.     ld    (hl),e
  385.     inc    hl
  386.     dec    bc
  387.     jr    @fill
  388.  
  389. ; Wait until timer counts down to zero.
  390. ; No registers altered.
  391.  
  392.     entry    @wait
  393.     cseg
  394. @wait:    push    af
  395. wa:    dtz    timer
  396.     jr    nz,wa
  397.     pop    af
  398.     ret
  399.  
  400. ; 8 by 8 Multiply
  401. ; DE=D*E, No other registers disturbed.
  402.  
  403. mulde:    push    hl
  404.     ld    h,d    ; Set up multipliers
  405.     ld    l,0    ; Clear some
  406.     ld    d,l
  407.     add    hl,hl    ; Shift and add (S/A) 1
  408.     jr    nc,m2    ; No add
  409.     add    hl,de    ; Add
  410. m2:    add    hl,hl    ; S/A 2
  411.     jr    nc,m3
  412.     add    hl,de
  413. m3:    add    hl,hl    ; S/A 3
  414.     jr    nc,m4
  415.     add    hl,de
  416. m4:    add    hl,hl    ; S/A 4
  417.     jr    nc,m5
  418.     add    hl,de
  419. m5:    add    hl,hl    ; S/A 5
  420.     jr    nc,m6
  421.     add    hl,de
  422. m6:    add    hl,hl    ; S/A 6
  423.     jr    nc,m7
  424.     add    hl,de
  425. m7:    add    hl,hl    ; S/A 7
  426.     jr    nc,m8
  427.     add    hl,de
  428. m8:    add    hl,hl    ; S/A 8
  429.     jr    nc,m9    ; Done
  430.     add    hl,de
  431. m9:    ex    de,hl    ; Product to DE
  432.     pop    hl
  433.     ret
  434.  
  435. ; 16 by 8 multiply.
  436. ; (DE)=(DE)*(C) No other registers altered.
  437.  
  438.     entry    muldec
  439. muldec:    push    hl
  440.     push    de
  441.     ld    e,c
  442.     call    mulde
  443.     ex    de,hl
  444.     ld    h,l
  445.     ld    l,0
  446.     pop    de
  447.     ld    d,c
  448.     call    mulde
  449.     add    hl,de
  450.     ex    de,hl
  451.     pop    hl
  452.     ret
  453.  
  454. ; Divide 16/8 to 8 with remainder, rounded and unrounded quotients.
  455. ; L  = HL/E, Unrounded, H=Remainder
  456. ; DE = HL/E, Rounded
  457. ; (BC) Not changed.
  458. ; Carry cleared if overflow.
  459.  
  460.     entry    div8
  461. div8:    push    bc
  462.     ld    a,h    ; Check for overflow
  463.     sub    e
  464.     jr    nc,d6    ; Overflow
  465.     ld    b,0    ; Initialize quotient register.
  466.     ld    c,8    ; Initialize shift counter.
  467. d3:    add    hl,hl    ; Shift HL left
  468.     jr    c,q1    ; Jump if a bit fell off
  469.     ld    a,h    ; Test subtract
  470.     sub    e    ; Will it fit?
  471.     jr    c,q2    ; No, too small
  472. q1:    ld    a,h    ; Do the subtraction for real
  473.     sub    e
  474.     ld    h,a    ; Stick it back
  475.     scf        ; Shift a 1 into qoutient
  476. d5:    ld    a,b    ; Set up to shift carry into quotient
  477.     rla        ; Shift
  478.     ld    b,a    ; Stick it back
  479.     dec    c    ; Update shift counter
  480.     jr    nz,d3    ; Loop if more shifts to do
  481.     ld    a,e    ; Round qoutient
  482.     ld    d,0
  483.     and    a    ; Clear carry
  484.     rra        ; Divide by 2
  485.     ld    e,b    ; Unrounded quotient to E
  486.     cp    h    ; Remainder*2>=divisor?
  487.     jr    nc,d4    ; No
  488.     inc    de    ; Yes, increment
  489. d4:    scf        ; Set flag for no overflow
  490. d6:    ld    l,b    ; Move unrounded quotient to L
  491.     pop    bc
  492.     ret
  493. q2:    and    a    ; Clear carry to shift a 0
  494.     jr    d5    ; Shift it in
  495.  
  496. ; Binary to decimal conversion for 16 bit value.
  497. ; Input: (HL) = Binary value.
  498. ; Output: NUMB has 5 digits, right justified, leading zeros supressed.
  499. ;   No registers preserved.
  500.  
  501.     entry    bindec,numb
  502.     dseg
  503. numb:    ds    5
  504.     cseg
  505. ; First count the 10,000's
  506. bindec:    ld    de,10000
  507.     ld    c,'0'
  508. b0:    or    a        ; Clear carry
  509.     sbc    hl,de
  510.     jr    c,b1
  511.     inc    c
  512.     jr    b0
  513. b1:    add    hl,de
  514.     ld    a,c
  515.     ld    (numb),a    ; 10,000's
  516. ; Now deal with the remaining number, <10,000
  517.     push    hl
  518.     ld    e,100
  519.     call    div8    ; (H)=2 low, (L)=2 hi digits
  520.     push    hl
  521.     ld    h,0
  522.     ld    e,10
  523.     call    div8    ; (H)=1st digit, (L)=2nd
  524.     ld    a,l
  525.     add    a,'0'
  526.     ld    (numb+1),a
  527.     ld    a,h
  528.     add    a,'0'
  529.     ld    (numb+2),a
  530.     pop    hl
  531.     ld    l,h
  532.     ld    h,0
  533.     ld    e,10
  534.     call    div8    ; (H)=3rd digit, (L)=4th
  535.     ld    a,l
  536.     add    a,'0'
  537.     ld    (numb+3),a
  538.     ld    a,h
  539.     add    a,'0'
  540.     ld    (numb+4),a
  541.     pop    hl
  542. ; Remove leading zeros
  543.     ld    c,4
  544.     ld    a,'0'
  545.     ld    hl,numb
  546. b2:    cp    (hl)
  547.     ret    nz
  548.     ld    (hl),' '
  549.     inc    hl
  550.     dec    c
  551.     jr    nz,b2
  552.     ret
  553.  
  554. ; Decimal to binary conversion for 16 bit values.
  555. ; Input: NUMB has 5 digit ASCII to be converted.
  556. ; Output: (HL) = Binary value, carry set if error.
  557. ; No registers preserved.
  558.  
  559.     entry    decbin
  560. decbin:    ld    hl,0
  561.     ld    de,numb
  562.     ld    b,5
  563.     ld    c,10
  564. r1:    ld    a,(de)
  565.     cp    ' '
  566.     jr    z,r2
  567.     cp    '9'+1
  568.     jr    nc,r3        ; Not a digit
  569.     sub    '0'
  570.     ret    c        ; Not a digit
  571.     push    de
  572.     ex    de,hl
  573.     ld    l,a
  574.     ld    h,0
  575.     call    muldec
  576.     add    hl,de
  577.     pop    de
  578. r2:    inc    de
  579.     dec    b
  580.     jr    nz,r1
  581.     or    a        ; Clear carry
  582.     ret
  583. r3:    scf
  584.     ret
  585.     end
  586. 
  587.