; ELBUG monitor ; Elektor SC/MP issue January 1978 (German) ; ; memory layout ; 0000-05f0 Elbug ROM (3*MM5204) ; 0600-06ff unused, may be 256 bytes RAM ; 0700-0707 hex display ; 0708-070f keyboard ; 07xx mirrors of display and keyboard ; 0800-0fff up to 2k RAM ; 0f00-0fff must be present, monitor RAM and stack area ; I/O ports hexio: .= x'700 ; right most 7 seg digit hexio1: .= x'701 ; typical pos of P2 pointing to display hexio6: .= x'706 hexio7: .= x'707 ; left most 7 seg digit hexin: .= x'708 ; keyboard input ; keyboard input word is ; 7 6 5 4 3 2 1 0 ; | | | | +--+--+--+------ hex keycode (0-f) ; | +--+--+------------------ command key (0-7) ; +--------------------------- is key pressed (0,1) ; command keys ky_run = x'f0 ky_mod = x'e0 ky_sub = x'd0 ky_cas = x'c0 ky_blk = x'b0 ky_cpu = x'a0 ky_dn = x'90 ky_up = x'80 ky_a = x'fa ky_e = x'fe ky_s = x'f5 ky_1 = x'f1 ky_2 = x'f2 stktop: .= x'fe0 dta = 0 ; data field for display addrl = 1 ; temporary address addrh = 2 digit4 = 2 ; save for address digits for display digit3 = 3 digit2 = 4 digit1 = 5 digit0 = 6 digitm = 7 blkcnt = 5 ; block count in CAS read and write cksum = 6 ; checksum buffer in CAS read and write bytesv = 7 ; byte save for CAS write bitcnt = 8 ; bit count for CAS read and write bitdly = 9 ; bit delay for CAS read write bitspd = x'a ; delay for bit for CAS read and write casl = x'b ; CAS start address cash = x'c adflg = x'10 ; flag: use read address from tape spdsav = x'14 ; save for CAS read speed speed = x'15 ; speed for CAS data transfer key7sg = 7 ; 7 segment value of hex key pressed keycod = 8 ; key code of pressed key keyhex = 9 ; hex key part of pressed key count = x'b ; digit count in main loop bldifh = x'b ; block difference in block move bldifl = x'c blendh = x'd ; block end address in block move blendl = x'e blbegh = x'f ; block start address in block move blbegl = x'10 cpuh = x'd ; CPU start address cpul = x'e outb = x'f ; number of bytes to output in display subl = x'13 ; 1st operand for subtraction subh = x'14 psaveh = x'16 ; PC save psavel = x'17 acsave = x'18 ; AC save spcnt = x'19 ; SP counter for nested subroutines level = x'1a ; Stack level incall = x'1b ; in CALL flag callh = x'1c ; address of caller calll = x'1d sph = x'1e ; stack pointer spl = x'1f top: .= x'ff0 ; top of RAM ; stack frame: ; dw caller address ; will be filled with caller by user code ; db p3h ; db p3l ; db p2h ; db p2l ; db p1h ; db p1l ; db status reg ; db e reg ; db accu reg .= x'000 cold: ; cold reset entry 0000 08 nop ; unusable instr because of PC pre-increment 0001 c415 ldi x'15 ; initialize speed of cassette 0003 c8f1 st stktop+speed 0005 c4e0 ldi l(stktop) ; init stack pointer 0007 c8f7 st stktop+spl ; to point to x'0fe0 (stktop) 0009 c40f ldi h(stacktop) 000b c8f2 st stktop+sph 000d c400 ldi x'00 ; clear number of nested routines 000f c8e9 st stktop+spcnt 0011 c8e9 st stktop+incall ; clear incall flag 0013 903d jmp dowarm ; skip to warm reset ; this is the entry point of the RETURN helper ; which pops off the registers from the last stack frame 0015 c0e9 return: ld stktop+spl ; load stack ptr 0017 31 xpal p1 ; into P1 0018 c0e5 ld stktop+sp 001a 35 xpah p1 001b c501 ld @1(p1) ; restore caller 001d c8de st stktop+callh ; from stack frame 001f c501 ld @1(p1) 0021 c8db st stktop+calll 0023 c501 ld @1(p1) ; restore stack frame p3h 0025 37 xpah p3 ; into p3 0026 c501 ld @1(p1) ; and also p3l 0028 33 xpal p3 ; into p3 0029 c501 ld @1(p1) ; restore stack frame p2h 002b 36 xpah p2 ; into p2 002c c501 ld @1(p1) ; and also p2l 002e 32 xpal p2 002f c501 ld @1(p1) ; restore stack frame p1h 0031 c8c4 st stktop+psaveh ; into a temporary 0033 c501 ld @1(p1) ; also p1l 0035 c8c1 st stktop+psavel 0037 c501 ld @1(p1) ; restore stack frame status 0039 07 cas ; into status reg 003a c501 ld @1(p1) ; restore stack frame e 003c 01 xae ; into e reg 003d c501 ld @1(p1) ; restore stack frame accu 003f c8b8 st stktop+acsave ; into a temporary 0041 c0b4 ld stktop+psaveh ; get P1 temporary 0043 35 xpah p1 ; xchg with p1h 0044 c8b9 st stktop+sph ; save new sph 0046 c0b0 ld psavel ; same for low byte of P1 0048 31 xpal p1 ; xchg with p1l 0049 c8b5 st stktop+spl ; save new spl 004b b8ad dld stktop+spcnt ; decrement nesting level 004d c0aa ld stktop+acsave ; restore accu 004f 3f xppc p3 ; jump to return address ; official entry points 0050 9004 docall: jmp call ; skip to call entry 0052 904d dowarm: jmp warm ; skip to warm entry 0054 90bf doreturn: jmp return ; skip to return entry ; this is the entry point of the CALL helper ; load the address you want to call into ; stktop+callh/calll and xppc3 to this call entry ; will save the registers to the stack pointed to by stkh/stkl ; and prepare return point of P3 to point to doreturn 0056 c8a1 call: st stktop+acsave ; save accu 0058 c0a6 ld stktop+spl ; load spl into P3 005a 33 xpal p3 ; xchg with p3l 005b c89b st stktop+psavel ; store p3l into temporary (return to caller) 005d c0a0 ld stktop+sph ; load sph into P3 005f 37 xpah p3 ; xchg with p3h 0060 c895 st stktop+psaveh ; store p3h into temporary 0062 c4ff ldi l(top) ; xchg top ram address into p1l 0064 31 xpal p1 ; 0065 cffc st @-4(p3) ; save p1l into stack frame 0067 c40f ldi h(top) ; xchg sp address into p1h 0069 35 xpah p1 006a cfff st @-1(p3) ; save p1h into stack frame 006c 01 xae ; get e reg 006d cb03 st 3(p3) ; save into stack frame 006f 06 csa ; get status reg 0070 cb02 st 2(p3) ; save into stack frame 0072 c1f9 ld -7(p1) ; get temporary acsave via p1 0074 cb04 st 4(p3) ; save into stack frame 0076 32 xpal p2 ; get p2l 0077 cfff st @-1(p3) ; save into stack frame 0079 36 xpah p2 ; get p2h 007a cfff st @-1(p3) ; save into stack frame 007c c1f8 ld -8(p1) ; get saved p3l via p1 007e cfff st @-1(p3) ; save into frame 0080 c1f7 ld -9(p1) ; get saved p3h via p1 0082 cfff st @-1(p3) ; save into frame 0084 c1fe ld -2(p1) ; get call addressl via p1 0086 cfff st @-1(p3) ; save into stack frame 0088 c1fd ld -1(p1) ; get call addressh via p1 008a cfff st @-1(p3) ; save into stack frame 008c 37 xpah p3 ; xchg into p3 (sph into accu) 008d c9ff st -1(p1) ; store new stack ptr h 008f c1fe ld -2(p1) ; get call addressl via p1 0091 33 xpal p3 ; xchg into p3 (spl into accu) 0092 c900 st 0(p1) ; store new stack ptr l 0094 a9fa ild -6(p1) ; increment spcnt via p1 0096 e1fb xor -5(p1) ; compare with calllevel 0098 9c04 jnz callit ; if not zero skip 009a c4ff ldi x'ff ; mark: in call, call frame contains data 009c c9fc st -4(p1) ; set marker 009e 3f callit: xppc p3 ; call address ; unmodified P3 will return here and does restore via RETURN 009f 90b3 jmp doreturn ; restore stackframe ; this is the warm start entry point 00a1 c400 warm: ldi l(hexio) ; load p1 with IO area 00a3 31 xpal p1 00a4 c407 ldi h(hexio) 00a6 35 xpah p1 00a7 c4e0 ldi l(stktop) ; load p2 with monitor area 00a9 32 xpal p2 00aa c40f ldi h(stktop) 00ac 36 xpah p2 00ad c42f ldi l(elbug) ; load p3 with 7-segment elbug text 00af 33 xpal p3 00b0 c401 ldi h(elbug) 00b2 37 xpah p3 00b3 c408 ldi x'08 ; counter for 7 segment displays 00b5 ca0b st count(p2) ; into temp counter ; this loop will display "..ELBuG " 00b7 c701 elloop: ld @1(p3) ; load first 7seg char 00b9 cd01 st @1(p1) ; put into display (build display "..ELBuG ") 00bb ba0b dld count(p2) ; decrement count 00bd 9cf8 jnz elloop ; loop over 8 chars 00bf c40a ldi l(waitky)-1 ; preset waitky routine 00c1 ca1d st calll(p2) ; in callh/l 00c3 c402 ldi h(waitky) 00c5 ca1c st callh(p2) 00c7 c40037c455333f js p3,call ; run call helper 00ce c480 ldi x'80 ; 7segment period 00d0 cdfd st @-3(p1) ; build display "...... " 00d2 cdff st @-1(p1) 00d4 cdff st @-1(p1) 00d6 cdff st @-1(p1) 00d8 c400 ldi x'00 ; empty field (where 'G' was) 00da cdff st @-1(p1) 00dc c208 ld keycod(p2) ; get keycode 00de 01 xae ; save into E 00df 40 lde ; reload it into accu 00e0 e4e0 xri ky_mod ; is modify key? 00e2 9853 jz domod ; yes, skip to modify 00e4 40 lde ; reload key 00e5 e4f0 xri ky_run ; is run key? 00e7 9c07 jnz warm1 ; no skip 00e9 c40137c4a0333f js p3,dorun ; goto run 00f0 40 warm1: lde ; reload key 00f1 e4d0 xri ky_sub ; is subtract key? 00f3 9c07 jnz warm2 ; no skip 00f5 c40337c4ea333f js p3,dosub ; goto subtract 00fc 40 warm2: lde ; reload key 00fd e4c0 xri ky_cas ; is key cassette? 00ff 9c07 jnz warm3 0101 c40237c4f1333f js p3,docas ; goto cassette 0108 40 warm3: lde ; reload key 0109 e4b0 xri ky_blk ; is key block transfer? 010b 9c07 jnz warm4 010d c40537c449333f js p3,doblk ; goto block transfer 0114 40 warm4: lde ; reload key 0115 e4a0 xri ky_cpu ; is key cpureg? 0117 9c88 jnz warm ; no loop back 0119 c40437c435333f js p3,docpu ; goto cpureg ; this is the HEX to 7 segment conversion table ; trick: x'0 is x'3f in 7segment, this recycles ; the last xppc3 of above js macro, so to load hextable ; one must use l(hextbl)-1 actually 0120 06 hextbl: .byte x'06 ; '1' 0121 5b .byte x'5b ; '2' 0122 4f .byte x'4f ; '3' 0123 66 .byte x'66 ; '4' 0124 6d .byte x'6d ; '5' 0125 7d .byte x'7d ; '6' 0126 07 .byte x'07 ; '7' 0127 7f .byte x'7f ; '8' 0128 6f .byte x'6f ; '9' 0129 77 .byte x'77 ; 'A' 012a 7c .byte x'7c ; 'b' 012b 58 .byte x'58 ; 'C' 012c 5e .byte x'5e ; 'd' 012d 79 .byte x'79 ; 'E' 012e 71 .byte x'71 ; 'F' ; this is the monitor prompt, reverse 012f 00 elbug: .byte x'00 ; ' ' 0130 3d .byte x'3d ; 'G' 0131 1c .byte x'1c ; 'u' 0132 7c .byte x'7c ; 'b' 0133 38 .byte x'38 ; 'L' 0134 79 .byte x'79 ; 'E' 0135 80 .byte x'80 ; '.' 0136 80 .byte x'80 ; '.' ; entry point of MODIFY 0137 c45c domode: ldi x'5c ; p1 points to hexio1 0139 c905 st 5(p1) ; 'o' into display 013b c454 ldi x'54 013d c906 st 6(p1) ; 'm' into display 013f c43e ldi l(getadr)-1 ; load getadr into caller 0141 ca1d st calll(p2) ; note: call helper is still in P3, 0143 3f xppc p3 ; and callh=02 == h(getadr) ; main loop of modify 0144 c201 moloop: ld addrl(p2) ; load address into p3 0146 33 xpal p3 0147 c202 ld addrh(p2) 0149 37 xpah p3 014a c300 ld 0(p3) ; read data value from address 014c ca00 st dta(p2) ; store it into data field 014e c4a0 ldi l(disply)-1 ; display address and data 0150 ca1d st calll(p2) ; note; callh=02 0152 c40037c455333f js p3,call ; call display address+data 0159 c40a ldi l(waitky)-1 ; load waitky 015b ca1d st calll(p2) 015d 3f xppc p3 ; call helper 015e c201 ld addrl(p2) ; get address into p3 0160 33 xpal p3 0161 c202 ld addrh(p2) 0163 37 xpah p3 0164 c208 ld kycode(p2) ; get keycode 0166 e480 xri ky_up ; is UP key? 0168 980a jz doup ; yes, skip 016a e480 xri ky_up ; undo xor 016c e490 xri ky_dn ; is DOWN key? 016e 9c0e jnz domod3 ; no skip 0170 c7ff ld @-1(p3) ; DN: get previous data value (decrement p3) 0172 9002 jmp domod2 ; continue 0174 c701 doup: ld @1(p3) ; UP: get next data value (increment p3) 0176 33 domod2: xpal p3 ; save address 0177 ca01 st addrl(p2) ; into addrl parameter 0179 37 xpah p3 017a ca02 st addrh(p2) 017c 90c6 jmp moloop ; loop modify 017e c207 domod3: ld key7sg(p2) ; must be hex key, get 7seg value 0180 c900 st 0(p1) ; put into display (position 1) 0182 c400 ldi x'00 ; clear other display nibble 0184 c9ff st -1(p1) 0186 c209 ld keyhex(p2) ; get hex value 0188 1e rr ; rotate into upper nibble 0189 1e rr 018a 1e rr 018b 1e rr 018c 01 xae ; save in E 018d c40037c455333f js p3,call ; still waitky preloaded, wait for key 0194 c201 ld addrl(p2) ; set p3 = address 0196 33 xpal p3 0197 c202 ld addrh(p2) 0199 37 xpah p3 019a c209 ld keyhex(p2) ; get hex value 019c 58 ore ; merge with first nibble 019d cb00 st 0(p3) ; store at memory position 019f 90a3 jmp moloop ; loop to modify ; this routine is left by RESET ; entry point of RUN 01a1 c450 dorun: ldi x'50 ; p1 points to hexio1 01a3 c906 st 6(p1) ; 'r' in display 01a5 c41c ldi x'1c ; 'u' in display 01a7 c905 st 5(p1) 01a9 c43e ldi l(getadr)-1 ; call get address 01ab ca1d st calll(p2) ; note callh=02 01ad c40037c455333f js p3,call ; call helper 01b4 c40a ld l(waitky)-1 ; call waitkey 01b6 ca1d st calll(p2) 01b8 3f xppc p3 ; call helper 01b9 c201 ld addrl(p2) ; set p3 = address 01bb 33 xpal p3 01bc c202 ld addrh(p2) 01be 37 xpah p3 01bf c7ff ld @-1(p3) ; adjust address (SC/MP is preincrement PC) 01c1 c450 ldi x'50 ; 'r' in display 01c3 c900 st 0(p1) 01c5 c41c ldi x'1c ; 'u' in display 01c7 c9ff st -1(p1) 01c9 3f xppc p3 ; execute routine 01ca c40f37c4ff333f js p3,cold ; goto cold start ; cassette helper routine to read a byte 01d1 c215 rbyte: ld speed(p2) ; get speed constant 01d3 1c sr ; divide by 2 01d4 ca14 st spdsav(p2) ; store it 01d6 c4ff rbyte1: ldi x'ff ; preset all ones 01d8 01 xae ; into E 01d9 19 sio ; shift bit in 01da 40 lde ; get current value 01db 9402 jp rbyte2 ; start bit seen? 01dd 90f7 jmp rbyte1 ; no wait 01df c4ff rbyte2: ldi x'ff ; preset all ones again 01e1 01 xae ; into E 01e2 c214 ld spdsav(p2) ; get speed count 01e4 ca0a st spdcnt(p2) ; store in temporary 01e6 ba0a rbyte3: dld spdcnt(p2) ; decrement speed delay 01e8 9cfc jnz rbyte3 ; wait 01ea c408 ldi x'08 ; number of bits 01ec ca08 st bitcnt(p2) ; save into bit counter rbyte4: 01ee c215 rbyte4: ld speed(p2) ; get bit delay 01f0 ca09 st bitdly(p2) ; stor into bit delay 01f2 c416 ldi x'16 01f4 8f00 dly 00 ; short delay 01f6 ba09 rbyte5: dld bitdly(p2) ; wait bit delay 01f8 9cfc jnz rbyte5 ; wait 01fa 19 sio ; shift in bit 01fb ba08 dld bitcnt(p2) ; decrement bit count 01fd 9cef jnz rbyte4 ; more bits? loop 01ff c215 ld speed(p2) ; reload delay 0201 ca09 st bitdly(p2) 0203 ba09 rbyte6: dld bitdly(p2) ; wait for another bit (stop bit) 0205 9cfc jnz rbyte6 0207 40 lde ; get byte read 0208 3f xppc p3 ; return from call 0209 90c6 jmp rbyte ; loop back to begin ; wait for a key press 020b c414 waitky: ldi l(return)-1 ; set p3 = return helper 020d 33 xpal p3 020e c400 ldi h(return) 0210 37 xpah p3 0211 c401 ldi l(hexio1) ; set p1 = hexio1 0213 31 xpal p1 0214 c407 ldi h(hexio1) 0216 35 xpah p1 0217 c4e0 ldi l(stktop) ; set p2 = stktop 0219 32 xpal p2 021a c404 ldi h(stacktop) 021c 36 xpah p2 021d c108 kyloop: ld 8(p1) ; read keyboard (hexio1+8) 021f 94fc jp kyloop ; wait for key pressed (bit 7=1) 0221 8f1e dly x'1e ; debounce 0223 c108 ld 8(p1) ; read keyboard again 0225 ca08 st keycod(p2) ; store key code 0227 d40f ani x'0f ; mask out hex data value (if any) 0229 ca09 st keyhex(p2) ; store data value 022b 01 xae ; save into e 022c c108 kyrel: ld 8(p1) ; read keyboard 022e 9402 jp ky1 ; wait for key released 0230 90fa jmp kyrel ; loop 0232 8f1e ky1: dly x'1e ; debounce 0234 c41f ldi l(hextbl)-1 ; load 7seg hex table into p1 0236 31 xpal p1 ; note: offset -1 0237 c401 ldi h(hextbl) 0239 35 xpah p1 023a c180 ld x'80(p1) ; index via E 023c ca07 st key7sg(p2) ; store into key7sg 023e 3f xppc p3 ; return ; get and display an address (put into addrh/l 023f c406 getadr: ldi l(hexio6) set p1 = hexio+6 0241 31 xpal p1 0242 c407 ldi h(hexio6) 0244 35 xpah p1 0245 c4e7 ldi l(stktop)+7 set p2 = stacktop+7 0247 32 xpal p2 0248 c40f ldi h(stktop+7) 024a 36 xpah p2 024b c404 ldi x'04 ; count for nibbles 024d caf9 st -7(p2) ; store in dta 024f c455 adloop: ldi l(call)-1 ; set p3 = call helper 0251 33 xpal p3 0252 c400 ldi h(call) 0254 37 xpah p3 0255 c40a ldi l(waitky)-1 ; prepare waitkey 0257 cba8 st call-1-calll(p3) ; via p3 0259 c402 ldi h(waitky) 025b cba7 st call-1-callh(p3) 025d 3f xppc p3 ; wait key 025e c4e0 ldi l(stktop) ; set p3 = stacktop 0260 33 xpal p3 0261 c40f ldi h(stktop) 0263 37 xpah p3 0264 c307 ld key7sg(p3) ; get 7seg val of key pressed 0266 cdff st @-1(p1) ; store into display 0268 c400 ldi x'00 ; clear other fields of display 026a c9ff st -1(p1) 026c c9fe st -2(p1) 026e c9fd st -3(p1) 0270 c9fc st -4(p1) 0272 c9fb st -5(p1) 0274 c309 ld keyhex(p3) ; get hexcode of key 0276 ceff st @-1(p2) ; store into addrl 0278 bb00 dld dta(p3) ; decrement digit count 027a 9cd3 jnz adloop ; if not done yet loop 027c c480 ldi x'80 ; set dots in display for data value 027e c9ff st -1(p1) 0280 c9fe st -2(p1) 0282 c306 ld digit1(p3) ; get first digit 0284 1e rr ; rotate 4 bits right into H nibble 0285 1e rr 0286 1e rr 0287 1e rr 0288 01 xae ; into E 0289 c305 ld digit2(p3) ; get next digit 028b 58 ore ; merge 028c cb02 st addrh(p3) ; store into high address 028e c304 ld digit3(p3) ; get next digit 0290 1e rr ; rotate 4 bits right into H nibble 0291 1e rr 0292 1e rr 0293 1e rr 0294 01 xae ; into E 0295 c303 ld digit4(p3) ; get last digit 0297 58 ore ; merge 0298 cb01 st addrl(p3) ; store into low address ; return from subroutine 029a c40037c4124333f goret: js p3,return ; return from subroutine 02a1 c4e0 disply: ldi l(stktop) ; set p3 = stacktop 02a3 33 xpal p3 02a4 c40f ldi h(stktop) 02a6 37 xpah p3 02a7 c4e0 ldi l(stktop) ; set p2 = stacktop 02a9 32 xpal p2 02aa c40f ldi h(stktop) 02ac 36 xpah p2 02ad c4e3 ldi l(stktop+digit4) ; set p1 = digit4 02af 31 xpal p1 02b0 c40f ldi h(stktop+digit4) 02b2 35 xpah p1 02b3 c403 ldi x'03 ; number of bytes to unpack 02b5 cb0f st outb(p3) ; store in temp count 02b7 c200 unpack: ld dta(p2) ; get data byte 02b9 d40f ani x'0f ; mask out low nibble 02bb cd01 st @1(p1) ; store into digit4 and following 02bd c601 ld @1(p2) ; get databyte again, and point to next 01bf 1c sr ; shift high nibble into low 02c0 1c sr 02c1 1c sr 02c2 1c sr 02c3 cd01 st @1(p1) ; store into digit3 and following 02c5 bb0f dld outb(p3) ; decrement byte count 02c7 9cee jnz unpack ; loop until all bytes unpacked 02c9 c41f ldi l(hextbl)-1 set p1 = hextable 02cb 31 xpal p1 02cc c401 ldi h(hextbl) 02ce 35 xpah p1 02cf c406 ldi x'06 ; store nibbles to convert 02d1 cb0f st outb(p3) 02d3 c601 cvthex: ld @1(p2) ; get nibble 02d5 01 xae ; into E 02d6 c180 ld x'80(p1) ; index via E: get 7seg code 02d8 ca05 st 5(p2) ; store at stacktop+8+N 02da bb0f dld outb(p3) ; decrement loop count 02dc 9cf5 jnz cvthex ; loop until done 02de c400 ldi l(hexio) ; set p1 = hexio 02e0 31 xpal p1 02e1 c407 ldi h(hexio) 02e3 35 xpah p1 02e4 c406 ldi x'06 ; 6 bytes to display 02e6 cb0f st outb(p3) dsply: 02e8 c601 dsloop: ld @1(p2) ; get 7 seg byte 02ea cd01 st @1(p1) ; store into display 02ec bb0f dld outb(p3) ; decrement count 02ee 9cf8 jnz dsloop ; loop for 6 bytes 02f0 90a8 jmp goret ; return from sub ; CAS entry point 02f2 c439 docas: ldi x'39 ; p1 is hexio1 02f4 c906 st 6(p1) ; 'C' in display 02f6 c45f ldi x'5f ; 'A' in display 02f8 c905 st 5(p1) 02fa 01 xae ; set E = 5f (bit 0='1') 02fb 19 sio ; shift out a '1' 02fc c4ff ldi x'ff ; set 255 02fe ca10 st adflg(p2) ; into adflg 0300 c40037c455333f js p3,call ; do call helper ; callh/l is still set to waitkey 0307 c45f ldi x'5f ; 'A' in display 0309 c900 st 0(p1) 030b c45e ldi x'5e ; 'd' in display 030d c9ff st -1(p1) 030f c208 ld keycod(p2) ; get keycode 0311 e4e0 xri ky_mod ; is modify key? 0313 9c1e jnz cas1 ; no skip 0315 c454 ldi x'54 ; 'm' in display 0317 c900 st 0(p1) 0319 c45c ldi x'5c ; 'o' in display 031b c9ff st -1(p1) 031d c43e ldi l(getadr)-1 ; call getadr 031f ca1d st calll(p2) 0321 3f xppc p3 0322 c201 ld addrl(p2) ; low value of argument 0324 ca15 st speed(p2) ; store into speed 0326 c40a ldi l(waitky)-1 ; call waitky 0328 ca1d st calll(p2) 032a 3f xppc p3 032b c45f ldi x'5f ; 'A' in display 032d c900 st 0(p1) 032f c45e ldi x'5e ; 'd' in display 0331 c9ff st -1(p1) 0333 c208 cas1: ld keycod(p2) ; get keycode 0335 e480 xri ky_up ; is UP key? 0337 982c jz casrd2 ; yes goto casrd ; this code is used for both write and read ; get a start and end address 0339 c43e caswr: ldi l(getadr)-1 ; call getadr (start address) 033b ca1d st calll(p2) 033d 3f xppc p3 033e c201 ld addrl(p2) ; move address into cash/l 0340 ca0b st casl(p2) 0342 c202 ld addrh(p2) 0344 ca0c st cash(p2) 0346 3f xppc p3 ; read end address (remains in addrh/l) 0347 c40a ldi l(waitky)-1 ; call waitkey 0349 ca1d st calll(p2) 034b 3f xppc p3 034c c208 ld keycod(p2) ; get keycode 034e e480 xri ky_up ; is UP key? 0350 9c04 jnz caswr0 ; no skip 0352 ca10 st adflg(p2) ; set flag = 0 (has alternative load address) 0354 900f jmp casrd2 0356 e480 caswr0: xri ky_up ; restore keycode 0358 e490 xri ky_dn ; is DOWN key? 035a 9802 jz gocasw ; yes goto cas write 035c 9050 jmp gores ; no goto reset 035e c40437c4e3333f gocasw: js p3,caswr ; goto caswr 0365 c41c casrd2: ldi x'1c ; 'u' in display 0367 c900 st 0(p1) 0369 c473 ldi x'73 ; 'P' in display 036b c9ff st -1(p1) 036d c4d0 ldi l(rbyte)-1 ; p3 = rbyte routine 036f 33 xpal p3 0370 c401 ldi h(rbyte) 0372 37 xpah p3 0373 c210 ld adflg(p2) ; is flag 0? (has alt load addr) 0375 980e jz skipad ; yes skip address 0377 3f xppc p3 ; get byte 0378 ca0c st cash(p2) ; store start addr 0379 3f xppc p3 037a ca0b st casl(p2) 037c 3f xppc p3 ; get byte 037d ca02 st addrh(p2) ; store end addr 0380 3f xppc p3 0381 ca01 st addrl(p2) 0383 9004 jmp casrd3 ; goto data reader 0385 3f skipad: xppc p3 ; skip 4 bytes 0386 3f xppc p3 ; using alternative load address 0387 3f xppc p3 0388 3f xppc p3 0389 c420 casrd3: ldi x'20 ; initialize block length 038b ca05 st blkcnt(p2) 038d c400 ldi x'00 ; clear checksum 038f ca06 st cksum(p2) 0391 02 ccl ; clear carry for checksum add 0392 c20b casrd5: ld casl(p2) ; load start address into p1 0394 31 xpal p1 0395 c20c ld cash(p2) 0397 35 xpah p1 0398 3f xppc p3 ; get byte 0399 c900 st 0(p1) ; store via p1 039b f206 add cksum(p2) ; add to checksum 039d ca06 st cksum(p2) ; store new checksum 039f 35 xpah p1 ; get pointer H 03a0 e202 xor addrh(p2) ; compare with end 03a2 9c11 jnz casrd4 ; not at end 03a4 31 xpal p1 ; get pointer L 03a5 e201 xor addrl(p2) ; compare with end 03a7 9c0c jnz casrd4 ; not at end 03a9 3f xppc p3 ; get final checksum 03aa e206 xor cksum(p2) ; compare with checksum 03ac 9c21 jnz caserr ; not same, then error 03ae c40f37c4ff333f gores: js p3,cold ; cold reset 03b5 06 casrd4: csa ; save status 03b6 01 xae ; into E 03b7 02 ccl ; clear carry 03b8 c20b ld casl(p2) ; add 1 to start address 03ba f401 adi 1 03bc ca0b st casl(p2) 03be c20c ld cash(p2) 03c0 f400 adi 0 03c2 ca0c st cash(p2) 03c4 40 lde ; get status 03c5 07 cas ; restore it 03c6 ba05 dld blkcnt(p2) ; decrement block count 03c8 9cc8 jnz casrd5 ; not end of block? 03ca 3f xppc p3 ; get block checksum 03cb e206 xor cksum(p2) ; compare with calculated 03cd 98ba jz casrd3 ; same, loop ; error occurred 03cf c401 caserr: ldi l(hexio1) ; point to display 03d1 31 xpal p1 03d2 c407 ldi h(hexio1) 03d4 35 xpah p1 03d5 c400 ldi x'00 ; ' Error' in display 03d7 c904 st 4(p1) 03d9 c479 ldi x'79 03db c903 st 3(p1) 03dd c450 ldi x'50 03df c902 st 2(p1) 03e1 c901 st 1(p1) 03e3 c9ff st -1(p1) 03e5 c45c ldi x'5c 03e7 c900 st 0(p1) 03e9 90fe caser1: jmp caser1 ; endless loop ; SUB entry point 03eb c46d dosub: ldi x'6d ; p1 is hexio1 03ed c906 st 6(p1) ; 's' in display 03ef c476 ldi x'76 ; 'h' in display 03f1 c905 st 5(p1) 03f3 c43e ldi l(getadr)-1 ; call getadr 03f5 ca1d st calll-stacktop(p2) 03f7 c40037c455333f js p3,call 03fe c440 ldi 40 ; '-' in display 0400 c900 st 0(p1) 0402 c400 ldi x'00 ; ' ' in display 0404 c9ff st -1(p1) 0406 c906 st 6(p1) ; clear 'sh' in display 0408 c905 st 5(p1) 040a c202 ld addrh(p2) ; copy address into subtra buffer 040c ca14 st subh(p2) 040e c201 ld addrl(p2) 0410 ca13 st subl(p2) 0412 3f xppc p3 ; get another address 0413 03 scl ; set carry for subtraction 0414 c213 ld subl(p2) ; get 1st op l 0416 fa01 cad addrl(p2) ; subtract 0418 ca01 st addrl(p2) ; store l result 041a c214 ld subh(p2) ; get 1st op h 041c fa02 cad addrh(p2) ; subtract 041e ca02 st addrh(p2) ; store h result 0420 c40a ldi l(waitky)-1 ; call wait key 0422 ca1d st calll(p2) 0424 3f xppc p3 0425 c4a0 ldi l(disply)-1 ; call display 0427 ca1d st calll(p2) 0429 3f xppc p3 042a c400 ldi x'00 ; clear data field in display 042c c9ff st -1(p1) 042e c900 st 0(p1) 0430 c448 ldi x'48 ; put '=' in display 0432 c905 st 5(p1) 0434 90fe sub1: jmp sub1 ; endless loop ; CPU entry point 0436 c439 docpu: ldi x'39 ; p1 = hexio1 0438 c906 st 6(p1) ; 'C' in display 043a c473 ldi x'73 ; 'P' in display 043c c905 st 5(p1) 043e c43e ldi l(getadr)-1 ; call getadr 0440 ca1d st calll(p2) 0442 c40037c455333f js p3,call 0449 c201 ld addrl(p2) ; copy start address 044b ca0e st cpul(p2) 044d c202 ld addrh(p2) 044f ca0d st cpuh(p2) 0451 3f xppc p3 ; call getadr 0452 c201 ld addrl(p2) ; breakpoint address 0454 31 xpal p1 0455 c202 ld addrh(p2) 0457 35 xpah p1 ; into p1 0458 c43f ldi x'3f ; save a XPPC 3 at breakpoint 045a c900 st 0(p1) 045c c471 ldi l(retcpu)-1 ; set return point 045e ca1d st calll(p2) 0460 c404 ldi h(retcpu) 0462 ca1c st callh(p2) 0464 c20e ld cpul(p2) ; get start address 0466 01 xae ; save 0467 c20d ld cpuh(p2) 0469 36 xpah p2 ; into P2 046a 40 lde 046b 32 xpal p2 046c c6ff ld @-1(p2) ; point to position before 046e c455 ldi l(call)-1 ; load P3 with call helper 0470 33 xpal p3 ; note: P3H is 0 from last call 0471 3e xppc p2 ; goto start of program ; will return here on breakpoint 0472 c4e0 retcpu: ldi l(stktop) ; load stacktop into P2 0474 32 xpal p2 0475 c40f ldi h(stktop) 0477 36 xpah p2 0478 c4d5 ldi l(stktop)-x'0b ; point to last stack frame 047a ca1f st spl(p2) ; store as new SP 047c c40a ldi l(waitky)-1 ; call wait key 047e ca1d st calll(p2) 0480 c402 ldi h(waitky) 0482 ca1c st callh(p2) 0484 c40037c455333f js p3,call 048b c208 ld keycod(p2) ; get keycode 048d 01 xae ; into E 048e c4a0 ldi l(disply)-1 ; preset addr of disply 0490 ca1d st calll(p2) 0492 c401 ldi l(hexio1) ; point to display 0494 31 xpal p1 0495 c407 ldi h(hexio1) 0497 35 xpah p1 0498 40 lde ; get keycode 0499 e4fa xri ky_a ; is 'A' key? 049b 9816 jz cpua ; yes display A 049d 40 lde ; get keycode 049e e4fe xri ky_e ; is 'E' key? 04a0 9815 jz cpue ; yes display E 04a2 40 lde ; get keycode 04a3 e4f5 xri ky_s is '5'? 04a5 9814 jz cpus ; yes display status 04a7 40 lde ; get keycode 04a8 e4f1 xri ky_1 ; is '1' ? 04aa 9813 jz cpu1 ; yes display P1 04ac 40 lde ; get keycode 04ad e4f2 xri ky_2 ; is '2'? 04af 9815 jz cpu2 ; yes display P2 04b1 90bf cploop: jmp retcpu ; loop 04b3 c2ff cpua: ld -1(p2) ; load A from stackframe 04b5 901c jmp cpush1 04b7 c2fe cpue: ld -2(p2) ; load E from stackframe 04b9 9018 jmp cpush1 04bb c2fd cpus: ld -3(p2) ; load status from stackframe 04bd 9014 jmp cpush1 04bf c2fc cpu1: ld -4(p2) ; load P1 from stackframe 04c1 01 xae 04c2 c2fb ld -5(p2) 04c4 9005 jmp cpshow 04c6 c2fa cpu2: ld -6(p2) ; load P2 from stackframe 04c8 01 xae 04c9 c2f9 ld -7(p2) 04cb ca02 cpshow: st addrh(p2) ; store 16 bit data 04cd 40 lde 04ce ca01 st addrl(p2) 04d0 3f xppc p3 ; call disply 04d1 9009 jmp cpuclr 04d3 ca01 cpush1: st addrl(p2) ; store 8 bit data 04d5 3f xppc p3 ; call disply 04d6 c400 ldi x'00 ; clear higher display nibbles 04d8 c903 st 3(p1) 04da c904 st 4(p1) 04dc c400 cpuclr: ldi x'00 ; clear data field 04de c900 st 0(p1) 04e0 c9ff st -1(p1) 04e2 90cd jmp cploop ; goto loop ; CAS Write entry point 04e4 c45e caswr: ldi x'5e ; p1 is hexio1 04e6 c900 st 0(p1) ; 'd' in display 04e8 c45c ldi x'5c ; 'o' in display 04ea c9ff st -1(p1) 04ec c20b ld casl(p2) 04ee 31 xpal p1 04ef c20c ld cash(p2) 04f1 35 xpah p1 ; start address into P1 04f2 c4d7 ldi l(wbyte)-1 ; preset wbyte routine 04f4 33 xpal p3 04f5 c405 ldi h(wbyte) 04f7 37 xpah p3 04f8 c20c ld cash(p2) ; write start address 04fa 3f xppc p3 ; to tape 04fb c20b ld casl(p2) 04fd 3f xppc p3 04fe c202 ld addrh(p2) ; write end address 0500 3f xppc p3 ; to tape 0501 c201 ld addrl(p2) 0503 3f xppc p3 0504 c420 caswr1: ldi x'20 ; set block count 0506 ca05 st blkcnt(p2) ; into temporary 0508 c400 ldi x'00 ; clear checksum 050a ca06 st cksum(p2) 050c 02 ccl ; clear carry for checksum add caswr2: 050d c100 caswr2: ld 0(p1) ; get first byte 050f 01 xae ; into E 0510 c206 ld cksum(p2) ; get checksum 0512 70 ade ; add 0513 ca06 st cksum(p2) ; save checksum 0515 40 lde ; get byte 0516 3f xppc p3 ; write byte 0517 35 xpah p1 ; get H start address 0518 e202 xor addrh(p2) ; compare with H end 051a 01 xae ; into E 051b 40 lde ; restore 051c e202 xor addrh(p2) ; restore into P1 051e 35 xpah p1 051f 40 lde ; get compare result 0520 9c08 jnz caswr3 ; not same, skip 0522 31 xpal p1 ; get L start 0523 e201 xor addrl(p2) ; compare with L end 0525 9819 jz caswr4 ; end reached, skip 0527 e201 xor addrl(p2) ; restore P1 0529 31 xpal p1 052a 06 caswr3: csa ; save status 052b 01 xae ; into E 052c 02 ccl ; clear carry 052d 31 xpal p1 ; increment P1 052f f401 adi 1 0530 31 xpal p1 0531 35 xpah p1 0532 f400 adi 0 0534 35 xpah p1 0535 40 lde ; restore status 0536 07 cas 0537 ba05 dld blkcnt(p2) ; decrement block count 0539 9cd2 jnz caswr2 ; no end of block, loop 053b c206 ld cksum(p2) ; get checksum 053d 3f xppc p3 ; write byte 053e 90c4 jmp caswr1 ; loop 0540 c206 caswr4: ld cksum(p2) ; last block, write chksum 0542 3f xppc p3 0543 c40f37c4ff333f caswr5: js p3,cold ; goto reset ; BLK entry point 054a c47c doblk: ldi x'7c ; p1 is hexio1 054c c906 st 6(p1) ; 'B' in display 054e c438 ldi x'38 ; 'L' in display 0550 c905 st 5(p1) 0552 c43e ldi l(getadr)-1 ; call getadr 0554 ca1d st calll(p2) 0556 c40037c455333f js p3,call 055d c201 ld addrl(p2) 055f ca10 st blbegl(p2) 0561 c202 ld addrh(p2) 0563 ca0f st blbegh(p2) ; save start address 0565 3f xppc p3 ; call getadr 0566 c201 ld addrl(p2) 0568 ca0e st blendl(p2) 056a c202 ld addrh(p2) 056c ca0d st blendh(p2) ; save end address 056e 3f xppc p3 ; call getadr 056f c40a ldi l(waitky)-1 ; call wait key 0571 ca1d st calll(p2) 0573 3f xppc p3 0574 03 scl ; set carry for subtraction 0575 c201 ld addrl(p2) ; target 0577 fa10 cad blbegl(p2) ; - start 0579 ca0c st bldifl(p2) ; store delta 057b c202 ld addrh(p2) 057d fa0f cad blbegh(p2) 057f ca0b st bldifh(p2) 0581 9429 jp blkpos ; if positive skip 0583 c210 ld blbegl(p2) 0585 31 xpal p1 0586 c20f ld blbegh(p2) 0588 35 xpah p1 ; start address into P1 0589 c201 ld addrl(p2) ; target into p3 058b 33 xpal p3 058c c202 ld addrh(p2) 058e 37 xpah p3 058f c501 blkn1: ld @1(p1) ; get byte 0591 cf01 st @1(p3) ; copy to target 0593 c5ff ld @-1(p1) ; decrement PTR 0595 31 xpal p1 ; compare P1 with end address 0596 e20e xor blendl(p2) 0598 01 xae 0599 40 lde 059a e20e xor blendl(p2) 059c 31 xpal p1 ; restore P1L 059d 40 lde 059e 9c08 jnz blkn3 ; not yet finished 05a0 35 xpah p1 05a1 e20d xor blendh(p2) 05a3 989e blkn2: jz caswr5 ; finished, cold reset 05a5 e20d xor blendh(p2) ; restore P1H again 05a7 35 xpah p1 05a8 c501 blkn3: ld @1(p1) ; increment P1 05aa 90e3 jmp blkn1 ; loop next byte 05ac c20e blkpos: ld blendl(p2) 05ae 31 xpal p1 05af c20d ld blendh(p2) 05b1 35 xpah p1 ; load end address into P1 05b2 c501 ld @1(p1) ; increment P1 05b4 03 scl ; add 1 + delta 05b5 c20e ld blendl(p2) 05b7 f20c add bldifl(p2) 05b9 33 xpal p3 ; set p3 = target address 05ba c20d ld blendh(p2) 05bc f20b add bldifh(p2) 05be 37 xpah p3 05bf c5ff blkp1: ld @-1(p1) ; load source byte 05c1 cfff st @-1(p3) ; store at target pos 05c3 31 xpal p1 ; copy downwards 05c4 e210 xor blbegl(p2) ; compare with blbeg 05c6 01 xae 05c7 40 lde 05c8 e210 xor blbegl(p2) 05ca 31 xpal p1 05cb 40 lde 05cc 9cf1 jnz blkp1 ; not yet done, loop 05ce 35 xpah p1 05cf e20f xor blbegh(p2) 05d1 98d0 jz blkn2 ; done now, goto cold start 05d3 e20f xor blbegh(p2) ; restore P2H 05d5 35 xpah p1 05d6 90e7 jmp blkp1 ; loop next byte ; write a byte serially to tape 05d8 ca07 wbyte: st bytesv(p2) ; save byte 05da c40b ldi x'0b ; 1 startbit, 8 data, 2 stop bits 05dc ca08 st bitcnt(p2) ; save bitcount 05de c400 ldi x'00 ; send startbit 05e0 01 xae 05e1 19 sio ; shift out 05e2 01 xae 05e3 ba20 dld 20(p2) ; waste time 05e5 c207 ld bytesv(p2) ; get byte 05e7 01 xae ; into E 05e8 c40b wbyte1: ldi x'0b ; delay 05ea 8f00 dly 00 05ec c215 ld speed(p2) ; get bit speed 05ee ca09 st bitdly(p2) ; stor into temp 05f0 ba09 wbyte2: dld bitdly(p2) ; wait 05f2 9cfc jnz wbyte2 05f4 19 sio ; send out bit 05f5 40 lde ; get data 05f6 dc80 ori x'80 ; set top bit (will be stop bit then) 05f8 01 xae ; back into E 05f9 ba08 dld bitcnt(p2) ; decrement bit count 05fb 9ceb jnz wbyte1 ; not yet done, loop 05fd 3f xppc p3 ; return from call 05fe 90d8 jmp wbyte ; reenter loop to routine