home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / ZCPR33 / A-R / POKE10.LBR / POKE10.ZZ0 / POKE10.Z80
Text File  |  2000-06-30  |  6KB  |  207 lines
  1. ;Program: POKE
  2. ;Version: 1.0
  3. ;Date: September 11, 1988
  4. ;Author: Bruce Morgen
  5. ;
  6. ;Purpose: Transient replacement for the RCP-based command of the
  7. ;same name, for Z33/Z34/NZCOM/Z3PLUS systems where the RCP space
  8. ;has been omitted to maximize TPA.  In addition to emulating its
  9. ;model's syntax, POKE.COM observes the host system's quiet flag
  10. ;for all displays other than the help screen and error messages,
  11. ;unless the local quiet byte at ENTRY+2 (102h under DDT) is
  12. ;patched to a non-zero value, in which case it is "quiet"
  13. ;regardless of the system's edicts.  Only Type 3 (@9800h) and
  14. ;Type 4 versions are in the distribution LBR - a Type 3 at 100h
  15. ;doesn't seem terribly useful, but it would work as expected.
  16.  
  17. z3env    equ    00
  18. fcb1    equ    5ch
  19. fcb2    equ    6ch
  20. tbuff    equ    80h
  21. cr    equ    13
  22. lf    equ    10
  23. bel    equ    7
  24.  
  25.     public    $memry,cout
  26.     extrn    eval16,phl4hc,sksp,sknsp,ishex,eprint,bout
  27.     extrn    z3init,puter2,getquiet,getefcb
  28.  
  29. ; TYPE 3 HEADER
  30.  
  31. ; Code modified as suggested by Charles Irvine to function correctly with
  32. ; interrupts enabled.  Program will abort with an error message when not
  33. ; loaded to the correct address (attempt to run it under CP/M or Z30).
  34.  
  35. entry:
  36.     jr    start0        ; Must use relative jump
  37. lqflg:    db    0        ; Patchable local quiet flag
  38.     db    'Z3ENV',3    ; Type-3 environment
  39. z3eadr:
  40.     dw    z3env        ; Filled in by Z33
  41.     dw    entry        ; Intended load address
  42.  
  43. start0:
  44.     ld    hl,0        ; Point to warmboot entry
  45.     ld    a,(hl)        ; Save the byte there
  46.     di            ; Protect against interrupts
  47.     ld    (hl),0c9h    ; Replace warmboot with a return opcode
  48.     rst    0        ; Call address 0, pushing RETADDR
  49.                 ; Onto stack
  50. retaddr:
  51.     ld    (hl),a        ; Restore byte at 0
  52.     dec    sp        ; Get stack pointer to point
  53.     dec    sp        ; To the value of RETADDR
  54.     pop    hl        ; Get it into HL and restore stack
  55.     ei            ; We can allow interrupts again
  56.     ld    de,retaddr    ; This is where we should be
  57.     xor    a        ; Clear carry flag
  58.     push    hl        ; Save address again
  59.     sbc    hl,de        ; Subtract -- we should have 0 now
  60.     pop    hl        ; Restore value of RETADDR
  61.     jr    z,start        ; If addresses matched, begin real code
  62.  
  63.     ld    de,notz33msg-retaddr; Offset to message
  64.     add    hl,de
  65.     ex    de,hl        ; Switch pointer to message into DE
  66.     ld    c,9
  67.     jp    0005h        ; Return via BDOS print string function
  68. notz33msg:
  69.     db    'Not Z33+$'    ; Abort message if not Z33-compatible
  70.  
  71. start:    ld    hl,(z3eadr)    ; Get environment pointer
  72.     call    z3init        ; Pass for Z3LIB
  73.     xor    a        ; Clear Program Error Flag
  74.     call    puter2        ; Via Z3LIB
  75.     ld    hl,fcb1+1    ; Point 1st char. of 1st DFCB
  76.     ld    a,(hl)        ; Into A
  77.     cp    '/'        ; Explicit help query?
  78.     jr    z,help        ; We honor them
  79.     cp    ' '        ; Invoked sans tail?
  80.     jr    z,help        ; Education required if so
  81.     ld    b,h        ; Save pointer to BC
  82.     ld    c,l
  83.     call    eval16        ; Evaluate requested address
  84.     or    a        ; Clear carry
  85.     sbc    hl,bc        ; Subtract, see if pointer moved
  86.     jp    z,error        ; If it didn't, not a good value
  87.     ld    hl,($memry)    ; Get first free memory above us
  88.     dec    hl        ; Adjust to last byte of program
  89.     sbc    hl,de        ; See if pointer is above us
  90.     jr    c,okpoke    ; If so, we're OK, proceed
  91.     ld    hl,entry    ; Get start of our code
  92.     sbc    hl,de        ; Make sure we're no self-poking
  93.     jp    c,addrer    ; Report the error if we are
  94. okpoke:    ld    hl,tbuff+1    ; Command tail start
  95.     call    sksp        ; Skip leading blank(s)
  96.     call    sknsp        ; & the 1st token
  97.     call    sksp        ; & the blank(s) after it
  98.     ld    a,(fcb2+1)    ; Is 1st char. is printable?
  99.     cp    ' '+1
  100.     jp    c,error        ; If not, report error
  101.     cp    '"'        ; ASCII mode delimiter?
  102.     jr    nz,hex        ; If not, do hex mode
  103.     call    lquiet        ; See if we're muzzled
  104.     call    z,disply    ; If not, display poke address
  105. ascilp:    inc    hl        ; Bump to start of ascii string
  106.     ld    a,(hl)        ; Get the character
  107.     or    a        ; Terminating null?
  108.     ret    z        ; All done if so
  109.     ld    (de),a        ; Otherwise do the poke
  110.     inc    de        ; Bump the target pointer
  111.     jr    ascilp        ; & loop until finished
  112. hex:    ld    b,d        ; Save DE to BC
  113.     ld    c,e
  114.     call    lquiet        ; Are we muzzled?
  115.     call    z,disply    ; If not display poke address
  116. hexlp:    ld    a,(hl)        ; Get the byte at (HL)
  117.     or    a        ; Test for null terminator
  118.     ret    z        ; All done if so
  119.     call    ishex        ; Legal hexadecimal digit?
  120.     jp    nz,error    ; Give up & report error if not
  121.     call    eval16        ; Evaluate to binary
  122.     inc    d        ; Test for 16-bit value
  123.     dec    d
  124.     jp    nz,error    ; Must be FFh or less
  125.     ld    (bc),a        ; Do the poke
  126.     inc    bc        ; Bump target pointer
  127.     call    sknsp        ; Skip trailing nonsense
  128.     call    sksp        ; & blanks
  129.     jr    hexlp        ; Loop until finished
  130.  
  131.  
  132. ; AI (Allegedly Intelligent) help screen routine
  133.  
  134. help:    call    eprint
  135.     db    'POKE, Version 1.0 (Type ',0
  136.     ld    a,(z3eadr-1)
  137.     add    a,'0'
  138.     call    bout
  139.     call    eprint
  140.     db    ' at ',0
  141.     ld    hl,entry
  142.     call    phl4hc
  143.     call    eprint
  144.     db    'h)',cr,lf
  145.     db    'Syntax:',cr,lf,' ',0
  146.     call    comnam
  147.     call    eprint
  148.     db    ' nn[ nn nn nn....] (or)',cr,lf,' ',0
  149.     call    comnam
  150.     call    eprint
  151.     db    ' "Any ASCII characters',cr,lf
  152.     db    ' where "nn" is any hex byte value',0
  153.     ret
  154.  
  155. ; Error exit routines
  156.  
  157. error:    call    eprint
  158.     db    bel,' Invalid address or byte value!',0
  159. erexit:    ld    a,0ffh
  160.     jp    puter2
  161.  
  162. addrer:    call    eprint
  163.     db    bel,'Address error, within this program!',0
  164.     jr    erexit
  165.  
  166. ; Subroutines
  167. ; ===========
  168.  
  169. ; Display program function and the target address passed in DE
  170.  
  171. disply:    call    eprint
  172.     db    'Poke at ',0
  173.     ex    de,hl
  174.     call    phl4hc
  175.     ex    de,hl
  176.     ld    a,'h'
  177. cout:    jp    bout        ; PUBLIC label for SYSLIB
  178.  
  179. ; See if local or system quiet bytes are set
  180.  
  181. lquiet:    ld    a,(lqflg)    ; Get local quiet flag
  182.     or    a
  183.     jp    z,getquiet    ; Consult system if zero
  184.     ret            ; Otherwise return NZ
  185.  
  186. ; Display actual invoked name of this program if Z3 knows it
  187. ;         (otherwise assume "POKE")
  188.  
  189. comnam:    call    getefcb
  190.     jr    z,noefcb
  191.     ld    b,8
  192. cmnmlp:    inc    hl
  193.     ld    a,(hl)
  194.     and    7fh
  195.     cp    ' '
  196.     call    nz,bout
  197.     djnz    cmnmlp
  198.     ret
  199. ;
  200. noefcb:    call    eprint
  201.     db    'POKE',0
  202.     ret
  203.  
  204. $memry:    ds    2        ; Filled in by linker
  205.  
  206.     end
  207.