1;
2;       CROMEMCO Z-1 MONITOR SOURCE
3;
4;       RETYPED FROM MANUAL AND MODIFIED TO ASSEMBLE WITH INTEL MACRO-80
5;       DECEMBER 2014, UDO MUNK
6;
7;PPAGE   EQU     0E1H            ;MUST BE THE HIGHER OF A PAIR OF NON-RAM PAGES.
8PPAGE   EQU     0FFH            ;PROM CAN'T BE DETECTED YET!
9;PSW    EQU     6               ;DEFINED BY INTEL ASSEMBLER ALREADY
10;SP     EQU     6
11PF      EQU     80H             ;PRIME-ABLE REG FLAG
12R2F     EQU     40H             ;2-BYTE REG FLAG
13BELL    EQU     07
14ESC     EQU     1BH
15CR      EQU     0DH
16LF      EQU     0AH
17STAT    EQU     0
18DAV     EQU     40H
19TBE     EQU     80H
20DATA    EQU     1
21TEMPS   EQU     16H             ;ROOM FOR TEMP STORAGE
22RSTLC   EQU     30H             ;RST LOCATION
23CASE    EQU     20H             ;DIFF BETW LOWER & UPPER CA
24;
25; Z80 OP-CODES
26JR      EQU     18H
27JRC     EQU     38H
28JRNC    EQU     30H
29JRZ     EQU     28H
30JRNZ    EQU     20H
31DJNZ    EQU     10H
32EXAF    EQU     08              ;EX AF,AF'
33EXX     EQU     0D9H
34RLD     EQU     0EDH
35RLD1    EQU     6FH
36CPI0    EQU     0EDH
37CPI1    EQU     0A1H
38CPIR    EQU     0EDH
39CPIR1   EQU     0B1H
40LDI     EQU     0EDH
41LDI1    EQU     0A0H
42LDIR    EQU     0EDH
43LDIR1   EQU     0B0H
44LDD     EQU     0EDH
45LDD1    EQU     0A8H
46LDDR    EQU     0EDH
47LDDR1   EQU     0B8H
48SET5A   EQU     0CBH
49ST5A1   EQU     0EFH
50;
51IX      EQU     0DDH
52IY      EQU     0FDH
53;
54; DISPLACEMENTS FROM IX OF HI BYTE OF REG PAIRS
55DUPC    EQU     0
56DUSP    EQU     -2
57DUAF    EQU     -4
58DUBC    EQU     -6
59DUDE    EQU     -8
60DUHL    EQU     -10
61DUIT    EQU     -12             ;USER I & INTERRUPT ENABLE
62DUIX    EQU     -14
63DUIY    EQU     -16
64DUAF2   EQU     -18
65DUBC2   EQU     -20
66DUDE2   EQU     -22
67DUHL2   EQU     -24
68
69        ORG     0E000H
70START:
71;
72; ENTER MONITOR FROM RESET
73;
74        MVI     A,1
75        OUT     40H             ;SELECT BANK 0
76;
77; PLACE SYS STACK AT HIGHEST PAGE OF AVAILABLE RAM.
78; ALLOW ROOM FOR TEMP STORAGE.
79;
80        LXI     H,00FFH-TEMPS+2
81INIT:   DCR     H
82        MOV     A,M
83        INR     M
84        CMP     M               ;DID IT CHANGE?
85        DB      JRZ
86        DB      INIT-$-1
87        DCR     M               ;YES. RESTORE IT.
88;
89; HL NOW POINTS TO BP STACK END
90;
91        MVI     M,0             ;BP STACK END MARK
92        MOV     A,L             ;SAVE
93        DCX     H               ;STORAGE FOR BPSP,LO
94        MOV     M,A             ;STORE BPSP,LO
95        LXI     D,DUHL2-2
96        DAD     D               ;TO END OF REG STORAGE
97        SPHL                    ;SYS SP
98;
99        DB      0EDH            ;SBC HL,DE: BACK TO UPC;HI
100        DB      52H             ;(CY WAS SET BY 'DAD D')
101        PUSH    H
102        DB      IX
103        POP     H               ;POP IX: STORAGE PNTR
104;
105        MVI     D,PPAGE         ;FORCE USER SP TO
106        DCX     H
107        DCX     H
108        MOV     M,D             ;POINT TO PROM
109;
110; SET BAUD RATE
111;
112INIT1:  MVI     A,0D8H          ;300 BAUD
113        CALL    BAUD
114        MVI     A,0F4H          ;110 BAUD
115        CNZ     BAUD
116        DB      JRNZ
117        DB      INIT1-$-1
118;
119        LXI     H,HEAD          ;HEADING
120        CALL    PMSG
121;
122        DB      JR
123        DB      CMND-$-1
124;
125BAUD:   OUT     STAT            ;SET BAUD RATE
126        CALL    GBYTE
127        CALL    GBYTE           ;CAN WE
128        ANI     7FH             ;READ
129        CPI     CR              ;A CR?
130        RET
131;
132; ENTER MONITOR FROM BRKPT
133;
134; SAVE MACHINE STATE. SAVES ALL REGS INCLUDING
135; SP, FINDS THE TOP OF RAM INSTALLED IN MACHINE
136; & SWITCHES THE STACK THERE.
137;
138SVMS:   XTHL                    ;ADJUST BRKPT RET ADDR
139        DCX     H
140        XTHL
141;
142        PUSH    H               ;SAVE
143        LXI     H,4
144        DAD     SP              ;USP (USER-SP)
145        XTHL                    ;TO STACK
146;
147        PUSH    PSW             ;UAF
148        PUSH    B               ;UBC
149        PUSH    D               ;UDE
150        PUSH    H               ;UHL
151;
152; FIND SYS STACK AGAIN
153;
154        LXI     H,00FFH-TEMPS
155SVMS1:  DCR     H               ;DECRM MEM PAGE
156        MOV     A,M
157        INR     M
158        CMP     M               ;DID IT CHANGE?
159        DB      JRZ
160        DB      SVMS1-$-1
161        DCR     M               ;YES. RESTORE IT.
162;
163        XCHG
164        LXI     H,11
165        DAD     SP              ;PNTS TO BPRA, HI BYTE
166        LXI     B,12
167        DB      LDDR            ;TRANSFER TO SYS STACK
168        DB      LDDR1
169        INX     D               ;DE HAS CURRENT VALUE OF SYS SP AND POINTS TO UR
170        INX     H               ;HL HAS CURRENT VALUE OF USER SP AND ALSO POINTS
171                                ;TO UR
172        XCHG
173        SPHL                    ;SYS SP
174;
175        DB      0EDH            ;LD A,I
176        DB      57H
177        MVI     C,0
178       	JPO     SVMS3           ;IFF?
179        INR     C               ;C NOW HOLDS USER-IFF
180SVMS3:  MOV     B,A
181        PUSH    B               ;UIF (USER-I & USER-IFF)
182;
183        DB      IX
184        PUSH    H               ;PUSH IX: UIX
185        DB      IY
186        PUSH    H               ;PUSH IY: UIY
187        LXI     B,DUPC-DUHL+1
188        DAD     B               ;PNTS TO UPC, HI BYTE
189        PUSH    H
190        DB      IX
191        POP     H               ;TO IX (POINTS TO UPC)
192;
193        DB      EXAF
194        PUSH    PSW
195        DB      EXX
196        PUSH    B               ;UBC2
197        PUSH    D               ;UDE2
198        PUSH    H               ;UHL2
199;
200        DB      IX
201        PUSH    H               ;PUSH IX
202        POP     H
203        INX     H               ;POINTS TO BPSP,LO
204        MOV     L,M             ;BPSP NOW IN HL
205;
206; CLEAR ALL BRKPTS
207;
208CLBP1:  MOV     A,M             ;BP STK EMPTY?
209        ORA     A
210        DB      JRZ
211        DB      CLBP2-$-1
212;
213        DCX     H
214        MOV     D,M
215        DCX     H
216        MOV     E,M
217        DCX     H
218        MOV     A,M
219        STAX    D               ;RESTORE CONTENTS TO MEM
220        DCX     H
221        DB      JR
222        DB      CLBP1-$-1
223;
224CLBP2:  MOV     A,L
225        DCX     H
226        MOV     M,A             ;ADJUST BPSP
227;
228        CALL    DSPR            ;DISPLAY USER REGISTERS
229;
230; GET 1-BYTE COMMAND.
231; RETURNS VALUE IN HL & JUMPS TO THAT ADDR.
232;
233CMND:   CALL    CRLF
234CMND1:  LXI     H,PRMPT
235        CALL    PMSG
236; HL NOW PNTS TO TBL ADDR
237        CALL    GCMND           ;DE GETS LETTER - 'A'
238        XCHG
239        DAD     H               ;TIMES 2
240        DAD     D               ; + TBL ADDR
241        MOV     E,M
242        INX     H
243        MOV     D,M
244        XCHG
245        LXI     D,CMND1         ;SET UP RETURN
246        PUSH    D               ;TO CMND
247        MOV     A,C             ;A & C HAVE CMND DELIMITER
248        PCHL
249;
250; REJECTS ALL BUT ALPHABETIC CHARACTERS.
251; RETURNS THE CHAR LESS THE ASCII VALUE OF 'A'.
252;
253ABCYZ:  SUI     'A'+CASE        ;'A' OR ABOVE?
254        DB      JRC
255        DB      ERROR-$-1
256        CPI     25D             ;'Y' OR BELOW?
257        RC                      ;IF NOT, CONTINUE BELOW
258;
259; ERROR & ESCAPE. RETURNS TO CMND WITH SP
260; POINTING TO SAVED-REG AREA (UHL2).
261;
262ERROR:  CALL    PSQS            ;PRINT '? <BELL>'
263ESCPE:  DB      IX
264        PUSH    H               ;PUSH IX
265        POP     H
266        LXI     D,DUHL2-1-DUPC
267        DAD     D
268        SPHL
269        DB      JR
270        DB      CMND-$-1        ;GET NEW CMND
271;
272; PROGRAM PROMS. ABORTS IF DESTINATION
273; IS NOT ON A 1K (400H) BOUNDARY, SWATH
274; WIDTH IS NOT A MULTIPLE OF 1K.
275;
276PROG:   MVI     B,181           ;360 ITERATION
277PROG1:  PUSH    B               ;SAVE # OF ITERATIONS
278        CALL    LD2N            ;SOURCE TO DE,INCRM TO BC,
279        PUSH    PSW             ;SAVE LATEST DELIMITER
280        MOV     A,B             ;IS INCRM A MULT OF 1024?
281        ANI     3
282        ORA     C
283        DB      JRNZ
284        DB      ERROR-$-1
285        POP     PSW             ;LAST DELIMITER
286        CALL    LINCR           ;SOURCE TO HL, DEST TO DE
287        MOV     A,D             ;IS DEST A MULT OF 1024?
288        ANI     3
289        ORA     E
290        DB      JRNZ
291        DB      ERROR-$-1
292;
293PROG3:  POP     PSW             ;ITERATION
294        PUSH    PSW
295        PUSH    B               ;INCREMENT
296        LXI     B,1024
297        PUSH    B               ;SAVE
298        CALL    MVE             ;MOVE IT
299        POP     B               ;RETRIEVE
300        XTHL                    ;INCRM TO HL
301        ORA     A               ;RESET CY
302        DB      0EDH            ;SBC HL,BC
303        DB      42H
304        XTHL                    ;SOURCE BACK TO HL
305        POP     B               ;NEW INCRM
306        DB      JRNZ
307        DB      PROG3-$-1       ;LOOP IF INCRM NOT 0
308        POP     PSW             ;CLEAN UP
309        RET                     ;BACK TO CMND
310;
311; COMMAND
312;
313; DISPLAY THE USER REGISTERS.
314;
315DSPR:   CALL    CRLF
316        DB      IX
317        PUSH    H               ;PUSH IX
318        POP     H               ;POINTS TO UPC
319        MVI     B,2             ;UPC & USP
320        CALL    PREGS
321        MVI     B,7             ;UAF THRU UIY
322        CALL    PREGS
323        MVI     B,4             ;UAF2 THRU UHL2
324PREGS:  CALL    P2BMS           ;PRINT 2 BYTES PNTED TO B
325        DB      DJNZ
326        DB      PREGS-$-1
327; (CONTINUE BELOW)
328;
329; PRINT CR & LF. PRESERVES ALL REGS BUT A.
330;
331CRLF:   MVI     A,CR
332; (CONTINUE BELOW)
333;
334; PRINT THE CHARACTER IN THE A-REGISTER. (CHECKS
335; INPUT FOR ESCAPE.) PRESERVES ALL REGS.
336PCHR:   PUSH    PSW             ;SAVE THE CHAR
337        IN      STAT
338        ANI     DAV
339        DB      JRZ
340        DB      PCHR2-$-1
341        IN      DATA
342        ANI     7FH
343;
344PCHR1:  CPI     ESC
345        DB      JRZ
346        DB      ESCPE-$-1
347;
348PCHR2:  IN      STAT
349        ANI     TBE
350        DB      JRZ
351        DB      PCHR2-$-1
352        POP     PSW
353        OUT     DATA
354        PUSH    PSW
355        PUSH    H
356        LXI     H,LFNN
357        CPI     CR
358        CZ      PMSG
359        POP     H
360        POP     PSW
361        RET
362;
363; GET CHARATER. RETURNS IT IN A. CONVERTS
364; ALPHA CHARS TO LOWER-CASE. ALTERS F.
365;
366GCHR:   CALL    GBYTE
367        ANI     7FH
368        CPI     'A'
369        DB      JRC
370        DB      GCHR1-$-1
371        ORI     20H             ;CONVERT TO LOWER-CASE
372GCHR1:  PUSH    PSW             ;SAVE THE CHAR
373        DB      JR
374        DB      PCHR1-$-1       ;PRINT IT
375;
376GBYTE:  IN      STAT
377        ANI     DAV
378        DB      JRZ
379        DB      GBYTE-$-1
380        IN      DATA
381        RET
382;
383; PRINT 2 BYTES IN (HL) & (HL - 1).
384; DECREMENTS HL BY 2. ALTERS A. PRESERVES OTHERS
385;
386P2BMS:  CALL    PNM
387        DCX     H
388        CALL    PNM
389        DCX     H
390;
391; PRINTS SPACE. PRESERVES ALL REGS BUT A.
392;
393SPACE:  MVI     A,20H
394        DB      JR
395        DB      PCHR-$-1
396;
397; IF HL IS A MULTIPLE OF 16, DO PADDR.
398;
399CK16B:  MVI     A,15
400;
401; ENTER WITH A CONTAINING N. IF HL IS A MULTIPLE
402; OF N+1, DO PADDR.
403;
404CKBND:  ANA     L
405        RNZ
406;
407; PRINT THE NUMBER IN HL, FOLLOWED BY A COLON.
408; PRESERVES ALL REGS EXCEPT A.
409;
410PADDR:  CALL    CRLF
411PADR1:  CALL    PNHL
412        MVI     A,':'
413        DB      JR
414        DB      PCHR-$-1
415;
416; LOAD TWO NUMBERS. FOLLOW WITH A CRLF.
417;
418L2NCR:  CALL    LD2N
419;
420; SKIP INITIAL SPACES.
421; IF DELIMITER NOT A CR, ERROR
422;
423SKSGC:  CALL    SKSG            ;LOOK FOR A NON-SPACE
424        CPI     CR              ;CR?
425        JNZ     ERROR
426        RET
427;
428; LOAD TWO NUMBERS. LOADS DE WITH THE BEGINNING
429; ADDR, N1. LOADS BC & HL WITH THE INCREMENT
430; N2-N1+1 (OR WITH N2 IF THE OPR IS 'S').
431; RETURN WITH LAST DELIMITER IN A.
432;
433LD2N:   CALL    GNHL            ;N1 TO HL, DELIMITER TO A
434        XCHG                    ;SAVE N1 IN DE
435        CALL    SKSG            ;GET NEXT NON-SPACE CHAR
436        CPI     'S'+CASE        ;SWATH?
437        DB      JRNZ
438        DB      LD2N1-$-1
439;
440        XRA     A               ;YES
441        CALL    GNHL            ;INCREMENT TO HL
442        DB      JR
443        DB      LD2N2-$-1
444;
445LD2N1:  CALL    GNHL            ;INCREMENT
446        ORA     A               ;CLEAR CY
447        DB      0EDH            ;SBC HL,DE
448        DB      52H             ;N2-N1
449        INX     H               ;INCLUDE END POINT
450LD2N2:  MOV     B,H
451        MOV     C,L             ;BC GETS THE INCRM
452        RET
453;
454; LOAD 3 OPERANDS. HL GETS SOURCE, DE THE
455; 3RD OPERAND, BC THE INCREMENT & A THE
456; LOW BYTE OF THE 3RD OPERAND.
457;
458LD3N:   CALL    LD2N
459; (CONTINUE BELOW)
460;
461; TRANSFER DE TO HL. ENTER WITH SPACE OR
462; 1ST DIGIT OF NUMBER IN A. GET NUMBER
463; INTO DE WITH LOW BYTE ALSO TO A.
464; FINISHES WITH A CRLF.
465;
466LINCR:  CALL    GNHL            ;SKIP SPACES, LOAD HL
467        CALL    SKSGC           ;WAIT FOR A CR
468        MOV     A,L
469        XCHG
470        RET
471;
472; CLEARS HL. IF ENTERED WITH HEX CHAR IN A,
473; SHIFTS IT INTO HL. O/W, IGNORES LEADING
474; SPACES. FIRST CAHR MUST BE HEX. CONTINUES
475; SHIFT UNTIL A NON-HEX CHAR RECEIVED & THEN
476; RETURNS WITH THE LETTER IN A.
477; PRESERVES B,C,D,E.
478;
479GNHL:   PUSH    B               ;SAVE
480GNHL1:  LXI     H,0             ;CLEAR BUFFER
481; STRIP LEADING SPACES & GET CHAR
482        CALL    SKSG
483; FIRST CHAR MUST BE HEX
484        CALL    HEXSH           ;IF HEX, SHIFT INTO HL
485        JC      ERROR           ;O/W,RETRY
486GNHL3:  CALL    GCHR
487GNHL5:  CALL    HEXSH           ;IF HEX SHIFT INTO HL
488        MOV     A,B             ;RESTORE CHAR
489        DB      JRNC
490        DB      GNHL3-$-1       ;IF HEX, CONTINUE
491        POP     B               ;IF NON-HEX, DONE
492        RET
493;
494; IF A CONTAINS HEX CHAR, SHIFTS BINARY EQUIVALE
495; INTO HL. IF NOT HEX, RET WITH CY SET. SAVES
496; ORIGINAL CHAR IN B
497;
498HEXSH:  MOV     B,A
499        SUI     '0'             ;< '0'?
500        RC
501        ADI     '0'-'G'-CASE
502        RC
503        SUI     'A'-'G'
504        DB      JRNC            ;OK IF >= 'A'
505        DB      HXSH0-$-1
506        ADI     'A'-'9'-1+CASE
507        RC
508HXSH0:  DW      0AC6H           ;ADI '9'+1-'0'
509; THE A-REG NOW CONTAINS THE HEX DIGIT IN BINARY
510; (THE HIGH-ORDER NIBBLE OF A IS 0.)
511HXSH4:  CALL    HXSH1           ;SHIFT 4 BITS INTO HL
512        CALL    HXSH1
513        CALL    HXSH1
514;
515HXSH1:  RLC                     ;SHIFT INTO BIT 4
516        DAD     H               ;SHIFT LEFT
517; CLEAR CY IN CASE OF RET FROM HEXSH
518        ORA     A
519        DB      0CBH            ;BIT 4,A
520        DB      67H             ;IS IT 0?
521        RZ
522        INX     H
523        RET
524;
525; RETURNS WITH A NON-SPACE IN THE A-REG.
526; IF ENTERED WITH A-REG CONTAINING A NULL
527; OR A SPACE, GETS NEW CHARS UNTIL FIRST
528; NON-SPACE OCCURS. ALTERS AF.
529;
530SKSG0:  XRA     A               ;START WITH A NULL
531;
532SKSG:   ORA     A               ;DOES A CONTAIN NULL?
533SKSG1:  CZ      GCHR
534        CPI     20H             ;SPACE?
535        DB      JRZ
536        DB      SKSG1-$-1
537        RET
538;
539; PRINT THE NUMBER IN HL. PRESERVES ALL REGS.
540;
541PNHL:   PUSH    PSW
542        PUSH    H               ;TO STACK
543        CALL    P4HEX
544        POP     H
545        POP     PSW
546        RET
547;
548; PRINT SPACE FOLLOWED BY THE NUMBER POINTED
549; TO BY HL. ALTERS A ONLY.
550;
551PSNM:   CALL    SPACE
552; (CONTINUE BELOW)
553;
554; PRINTS THE NUMBER POINTED TO BY HL.
555; PRESERVES ALL REGISTERS.
556;
557PNM:    PUSH    PSW
558        CALL    P2HEX
559        POP     PSW
560        RET
561;
562; PRINTS 4 HEX CHARS FROM TOP OF STACK.
563; ALTERS F,H,L.
564;
565P4HEX:  LXI     H,3
566        DAD     SP              ;HL = SP
567        CALL    P2HEX           ;HIGH BYTE
568        DCX     H               ;LOW BYTE
569;
570; PRINT THE NUMBER POINTED TO BY HL.
571; PRESERVES ALL REGS EXCEPT AF.
572P2HEX:  MOV     A,M             ;GET THE NUMBER
573        RRC
574        RRC
575        RRC
576        RRC
577        CALL    P1HEX           ;LEFT NIBBLE
578        MOV     A,M             ;NOW DO THE RIGHT NIBBLE
579P1HEX:  ANI     0FH             ;MASK
580        CPI     10              ;<= 9?
581        DB      JRC
582        DB      P1HX1-$-1
583        ADI     7               ;A THRU F
584P1HX1:  ADI     30H             ;ASCII BIAS
585        JMP     PCHR            ;PRINT IT
586;
587; PRINT MESSAGE. ENTER WITH ADDR OF MSG
588; IN HL. MSG IS TERMINATED BY 00 THRU 07.
589; PRESERVES FLAGS, CLEARS A, INCRM HL.
590;
591; PRINT '? <BELL>'
592;
593PSQS:   LXI     H,SQS
594;
595PMSG:   MVI     A,0             ;CLEAR A (FOR GNHL)
596        PUSH    PSW             ;SAVE FLAGS
597PMSG1:  MOV     A,M
598        INX     H
599        CALL    PCHR
600        ANI     0F8H            ;<NULL> THRU <BELL>?
601        DB      JRNZ
602        DB      PMSG1-$-1
603        POP     PSW
604        RET
605;
606; DE GETS THE FIRST ALPHA CHAR - 'A'.
607; C GETS THE FIRST DELIMITER.
608; B IS INITIALIZED TO '0' & RETURNS
609; THE LAST CMND CHARACTER.
610;
611GCMND:  CALL    SKSG0           ;GET NON-SPACE
612        CALL    ABCYZ           ;ALPHA CHECK
613        MOV     E,A
614        MVI     D,0             ;DE HAS TBL DISPLACEMENT
615        MVI     B,'O'+CASE      ;INITIALIZE FOR GO CMND
616GCMN1:  CALL    GCHR            ;GET CHAR
617        CPI     30H             ;DELIMITER?
618        MOV     C,A             ;DELIM STORE
619        RC                      ;IF SO, DONE
620        MOV     B,A             ;LAST CHAR STORE
621        DB      JR
622        DB      GCMN1-$-1
623;
624; COMMAND
625;
626VERIF:  CALL    LD3N            ;GET 3 OPERANDS
627;
628; COMPARES TWO AREAS OF MEMORY. ENTER WITH
629; SOURCE IN HL. DESTINATION IN DE & COUNT
630; IN BC. ALTERS ALL REGISTERS.
631;
632VRFY:   LDAX    D               ;DESTINATION
633        DB      CPI0            ;COMPARE TO SOURCE
634        DB      CPI1
635        CNZ     CRLF            ;IF NOT SAME, CRLF
636        DCX     H               ;(CPI INCRMS HL)
637        CNZ     PNHL            ; & PRINT SOURCE ADDR
638        CNZ     PSNM            ; & SOURCE CONTENTS
639        XCHG
640        CNZ     PSNM            ; & DEST CONTENTS
641        XCHG
642        INX     H               ;RESTORE HL FOR CPI
643        INX     D               ;NEXT DEST
644        JPO     CRLF            ;IF BC = 0, DONE
645        DB      JR
646        DB      VRFY-$-1
647;
648; COMMAND
649;
650MOVE:   CALL    LD3N            ;OPERANDS
651        MVI     A,1             ;# OF ITERATION
652;
653; MOVE FROM ONE LOCATION TO ANOTHER. ENTER
654; WITH SOURCE ADDR IN HL, DEST IN DE, BYTE
655; COUNT IN BC. THE MOVE IS ITERATED N TIMES,
656; WHERE N = TWICE THE CONTENTS OF A, LESS ONE.
657; INCREMENTS HL & DE BY BC. CHECKS RESULT
658; & PRINTS THE ERRORS FOUND.
659MVE:    STC                     ;CY IS USED IN ITERATION COUNT
660MVE1:   PUSH    H               ;SOURCE
661        PUSH    D               ;DEST
662        PUSH    B               ;BYTE COUNT
663        DI                      ;FOR PROM PROGRAMMING
664        DB      LDIR            ;ONE ITERATION
665        DB      LDIR1
666        EI
667        POP     B
668        POP     D
669        POP     H
670; ITERATION CALCULATIONS
671        CMC
672        DB      JRC
673        DB      MVE1-$-1
674        DCR     A
675        DB      JRNZ
676        DB      MVE1-$-1
677; CHECK RESULT
678        DB      JR
679        DB      VRFY-$-1
680;
681; COMMAND
682;
683; GO <CR>     EXECUTION BEGINS AT USER PC.
684;
685; COMMAND
686;
687; GO <ADDR1>/<ADDR2> ... >ADDRN>
688; EXECUTION BEGINS AT ADDR1 WITH BREAKPOINTS SET
689; AT ADDR2,...,ADDRN.
690;
691GO:     MOV     A,B             ;CHECK THAT THE LAST
692        CPI     'O'+CASE        ;CMND CHAR IS 'O'
693        JNZ     ERROR
694        MOV     A,C             ;CMND DELIMITER
695        MVI     C,0             ;BP FLAG
696GO1:    CALL    SKSG            ;WAIT FOR NON-SPACE
697        CPI     CR
698        DB      JRZ
699        DB      RETN-$-1        ;RETN IF CR
700        CPI     '/'             ;BP?
701        DB      JRNZ
702        DB      GO3-$-1
703        MVI     C,1             ;SET BRKPT FLAG
704        LXI     H,RSTLC         ;TRANSFER
705        MVI     M,0C3H          ;'JMP SVMS' TO
706        LXI     H,SVMS
707        SHLD    RSTLC+1         ;RST LOC
708        XRA     A
709GO3:    CALL    GNHL            ;GET ADDR
710        DW      41CBH           ;BIT 0,C: FLAG SET?
711        XCHG
712        DB      JRZ
713        DB      GO5-$-1         ;JMP IF NO BP
714        DB      IX
715        PUSH    H               ;PUSH IX
716        POP     H
717        INX     H
718        MOV     L,M             ;HL = BPSP
719;
720        INX     H               ;BUMP BPSP
721        XCHG                    ;DE=BPSP, HL= BP ADDR
722        MOV     B,M             ;CONTENTS
723        MVI     M,0C7H+RSTLC    ;RST INSTRUCTION
724        XCHG                    ;HL=BPSP
725        MOV     M,B             ;TO BP STACK
726        INX     H               ;BUMP BPSP
727        MOV     M,E             ;BP ADDR TO STACK
728        INX     H
729        MOV     M,D
730        INX     H
731        MVI     M,01            ;PUNCTUATION (BP SET)
732        DB      IX
733        MOV     M,L             ;LD (IX+1),L
734        DB      1
735        DB      JR
736        DB      GO1-$-1
737; CHANGE USER PC
738GO5:    DB      IX
739        MOV     M,D             ;LD (IX+DUPC),D
740        DB      DUPC
741        DB      IX
742        MOV     M,E             ;LD (IX+DUPC-1),E
743        DB      DUPC-1
744        DB      JR
745        DB      GO1-$-1         ;BACK FOR MORE
746;
747RETN:   POP     H               ;STRIP CMND ADDR FROM STK
748        POP     H               ;UHL2
749        POP     D               ;UDE2
750        POP     B               ;UBC2
751        POP     PSW             ;UAF2
752        DB      EXX
753        DB      EXAF
754        DB      IY
755        POP     H               ;POP IY: UIY
756        DB      IX
757        POP     H               ;POP IX: UIX
758;
759        POP     PSW             ;UIF
760        DB      0EDH
761        DB      47H             ;LD I,A: UI
762        DI
763        DB      JRNC
764        DB      RETN1-$-1
765        EI
766; IFF NOW RESTORED
767RETN1:  POP     H               ;UHL
768        POP     D               ;UDE
769        POP     B               ;UBC
770        POP     PSW             ;UAF
771        XTHL                    ;USP TO HL, UHL TO (SP)
772        PUSH    PSW
773        PUSH    B
774        PUSH    D
775        LXI     B,10
776        XCHG                    ;USP TO DE
777        DCX     D
778        LXI     H,9
779        DAD     SP
780        DB      LDDR            ;TRANSFER UPC THRU UHL, L
781        DB      LDDR1           ;TO USER STACK
782        XCHG                    ;IS (USER SP - 1) RAM?
783        MOV     A,M
784        INR     M
785        CMP     M               ;DID IT CHANGE?
786        DB      JRZ
787        DB      RETN2-$-1
788;
789        DCR     M               ;YES, RESTORE IT.
790        SPHL                    ;CHABGE TO USER STACK
791        INX     SP              ;CORRECT FOR LDDR EXTRA DCR
792;
793RETN2:  POP     D               ;OTHERWISE, CONTINUE SYS
794        POP     B
795        POP     PSW
796        POP     H
797        RET
798;
799; ENTER WITH HL POINTING TO MEMORY & B CONTAINING
800; THE 2-BYTE REG FLAG.
801; PRINTS SPACE, CONTENTS OF (HL) & ALSO (HL-1) FOR
802; 2-BYTE REGS, GETS SUBSTITUTION VALUE INTO DE,
803; WRITES E INTO (HL) OR (HL-1) FOR 2-BYTE REGS.
804; RETURNS WITH Z-FLAG RESET IFF A CHANGE IS INDICATED
805; (BY A LACK OF '.') FOR A 2-BYTE REG.
806; PRESERVES BC,HL.
807;
808GSUBV:  CALL    PSNM            ;PRINT (HL)
809        DB      0CBH            ;BIT 6,B
810        DB      70H             ;2-BYTE REG?
811        DB      JRZ
812        DB      GSBV1-$-1
813        DCX     H               ;YES, PRINT
814        CALL    PNM             ;  LO BYTE
815GSBV1:  MVI     A,'.'
816        CALL    PCHR
817        CALL    GCHR
818        CPI     '.'             ;SUSTITUTION?
819        CZ      PCHR            ;IF NOT, PRINT ANOTHER
820        DB      JRZ
821        DB      GSBV2-$-1
822        XCHG
823        CALL    GNHL            ;NEW VALUE
824        XCHG                    ;TO DE
825        MOV     M,E             ;LOAD MEM
826; THE FOLLOWING TEST IS FOR SBSR
827        DB      0CBH            ;BIT 6,B
828        DB      70H             ;2-BYTE REG?
829GSBV2:  INX     H
830        RET
831;
832; COMMAND
833;
834; SM <ADDR>    SUBSTITUTE MEMORY LOCATION.
835;
836; COMMAND
837;
838; SR <REGISTER NAME>    SUBSTITUTE USER REGISTER
839;
840; REGISTER NAMES: P (PC), S (SP),
841;                 A, F, B, C, D, E, H, L,
842;                 I, T (IFF), X (IX), Y (IY),
843;                 A',F',B',C',D',E',H',L'.
844;
845SUBST:  MOV     A,B             ;LAST CMND CHAR
846        CPI     'R'+CASE        ;SR?
847        MOV     A,C             ;DELIMITER
848        DB      JRZ
849        DB      SBSR-$-1
850;
851SBSM:   CALL    GNHL            ;HL GETS ADDR
852SBSM1:  MVI     B,0             ;REG FLAGS
853; PRINT CURRENT VALUE, REQUEST NEW VALUE &
854; PRINT IT IF GIVEN
855        CALL    GSUBV
856        MVI     A,7             ;8 ENTRIES PER LINE
857        CALL    CKBND
858        DB      JR
859        DB      SBSM1-$-1
860;
861SBSR:   CALL    GCMND           ;DE GETS LETTER - 'A'
862        LXI     H,RGTBL
863        DAD     D               ;PNTS TO REG DISPLACEMENT
864        MOV     B,D             ;D = 0
865        DB      0CBH            ;BIT 7,(HL)
866        DB      7EH             ;A THRU L?
867        DB      JRZ
868        DB      SBSR1-$-1
869        MOV     A,C             ;LAST CMND DELIMITER
870        CPI     20H             ;SPACE?
871        DB      JRZ
872        DB      SBSR1-$-1
873        CPI     ''''            ;PRIMED?
874        JNZ     ERROR
875        MVI     B,DUAF-DUAF2    ;YES
876;
877SBSR1:  MOV     A,M             ;DISPLACEMENT & FLAGS
878        ORA     A               ;IF 0, ILLEGAL CMND
879        JZ      ERROR
880        ANI     1FH             ;STRIP FLAGS OFF
881        ADD     B               ;ADJUST FOR PRIMES
882        MOV     E,A             ;DE GETS DISPL (D=0)
883        MOV     B,M             ;SAVE ORIG ENTRY
884        DB      IX
885        PUSH    H               ;PUSH IX
886        POP     H               ;STACK FRAME
887        DB      0EDH            ;SBC HL,DE
888        DB      52H             ;PNTS TO USER REG
889; PRINT CURRENT VALUE, DE GETS SUBSTITUTION
890; VALUE, IF ANY, & (HL) OR (HL-1) GETS E.
891; Z-FLAG RESET IFF CHANGE FOR A 2-BYTE REG.
892        CALL    GSUBV
893        DB      JRZ
894        DB      SBSR3-$-1
895        MOV     M,D             ;NO. HI BYTE
896SBSR3:  CALL    SPACE
897        DB      JR
898        DB      SBSR-$-1
899;
900DISPL:  MOV     A,B             ;LAST CMND CHAR
901        CPI     'R'+CASE        ;DR?
902        MOV     A,C             ;CMND DELIMITER
903        JZ      DSPR
904;
905; COMMAND
906;
907; DISPLAY MEMORY.
908;
909DSPM:   CALL    L2NCR           ;INTO DE, INCRM TO BC,
910                                ;DELIMITER TO A
911        XCHG                    ;N1 TO HL
912DSPM1:  CALL    PADR1           ;PRINT ADDR, ':'
913DSPM2:  CALL    PSNM            ;PRINT CONTENTS OF MEM
914        INX     H
915        DCX     B
916        MOV     A,B
917        ORA     C               ;DONE?
918        JZ      CRLF
919        CALL    CK16B           ;CHECK FOR 16 COUNT
920        DB      JR
921        DB DSPM2-$-1
922;
923; COMMAND
924; READ BINARY INPUT FROM DATA PORT
925;
926READB:  CALL    L2NCR           ;GET MEM ADDRS
927RDB1:   CALL    GBYTE           ;GET INPUT
928        STAX    D               ;TO MEM
929        INX     D
930        DCX     B               ;COUNT
931        MOV     A,B
932        ORA     C               ;BC = 0?
933        DB      JRNZ
934        DB      RDB1-$-1
935        RET
936;
937; COMMAND
938; WRITE BINARY OUTPUT TO DATA PORT
939;
940WRITB:  CALL    L2NCR           ;GET MEM ADDRS
941WRTB1:  IN      STAT
942        ANI     TBE
943        DB      JRZ
944        DB      WRTB1-$-1
945        LDAX    D
946        OUT     DATA
947        INX     D
948        DCX     B
949        MOV     A,B
950        ORA     C
951        DB      JRNZ
952        DB      WRTB1-$-1
953        RET
954;
955; COMMAND
956; OUT <DATA-BYTE> <PORT NUMBER>
957;
958OUTP:   CALL    GNHL
959        XCHG                    ;E GETS DATA
960        CALL    GNHL            ;GET PORT NUMBER
961;
962        MOV     C,L             ;TO C
963        DW      59EDH           ;OUT (C),E
964        RET
965;
966HEAD:   DB      CR
967        DB      CR
968        DB      'CROMEMCO MON1.0 C.1976'
969        DB      0
970;
971SQS:    DB      ' ?'
972        DB      BELL
973;
974LFNN:   DB      LF
975        DB      7FH             ;NULL
976        DB      0
977;
978PRMPT:  DB      ':'
979        DB      0
980; THE COMMAND TBL MUST IMMEDIATELY FOLLOW
981; THE PROMT MESSAGE
982        DW      ERROR           ;A
983        DW      ERROR           ;BANK
984        DW      ERROR           ;C
985        DW      DISPL           ;DISPLAY
986        DW      ERROR           ;ENTER
987        DW      ERROR           ;FILE
988        DW      GO
989        DW      ERROR           ;H
990        DW      ERROR           ;INPUT
991        DW      ERROR           ;J
992        DW      ERROR           ;K
993        DW      ERROR           ;LIST
994        DW      MOVE
995        DW      ERROR           ;NUMBER
996        DW      OUTP            ;OUTPUT
997        DW      PROG            ;PROGRAM
998        DW      ERROR           ;Q
999        DW      READB           ;READ BINARY OR ASCII
1000        DW      SUBST           ;SUBSTITUTE
1001        DW      ERROR           ;TRAP
1002        DW      ERROR           ;UNEQUAL
1003        DW      VERIF           ;VERIFY
1004        DW      WRITB           ;WRITE BINARY OR ASCII
1005        DW      ERROR           ;X
1006        DW      ERROR           ;Y
1007;
1008RGTBL:  DB      -DUAF+PF        ;A
1009        DB      -DUBC+PF        ;B
1010        DB      -DUBC+1+PF      ;C
1011        DB      -DUDE+PF        ;D
1012        DB      -DUDE+1+PF      ;E
1013        DB      -DUAF+1+PF      ;F
1014        DB      0
1015        DB      -DUHL+PF        ;H
1016        DB      -DUIT           ;I
1017        DB      0
1018        DB      0
1019        DB      -DUHL+1+PF      ;L
1020        DB      0
1021        DB      0
1022        DB      0
1023; INTEL MACRO-80 FLAGS A VALUE ERROR, BUT CORRECT VALUE 40 IS COMPUTED
1024;        DB      -DUPC+R2F       ;PC
1025	DB	40H
1026        DB      0
1027        DB      0
1028        DB      -DUSP+R2F       ;SP
1029        DB      -DUIT+1         ;T (INTERRUPT ENABLE)
1030        DB      0
1031        DB      0
1032        DB      0
1033        DB      -DUIX+R2F       ;X (IX)
1034        DB      -DUIY+R2F       ;Y (IY)
1035
1036        END
1037