TER JRZ SCAN10 ;ZERO FLAG SET IF DELIMITER FOUND INX D ;PT TO NEXT CHAR IN COMMAND LINE JR SCAN8 SCAN9: INX H ;PT TO NEXT BYTE IN FCBDN MVI M,' ' ;FILL FILENAME PART WITH DJNZ SCAN9 ; ; EXTRACT FILE TYPE FROM POSSIBLE FILENAME.TYP ; SCAN10: MVI B,3 ;PREPARE TO EXTRACT TYPE CPI '.' ;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE JRNZ SCAN15 ;FILL FILE TYPE BYTES WITH INX D ;PT TO CHAR IN COMMAND LINE AFTER '.' SCAN11: CALL SDELM ;CHECK FOR DELIMITER JRZ SCAN15 ;FILL REST OF TYPE IF IT IS A DELIMITER INX H ;PT TO NEXT BYTE IN FCBDN CPI '*' ;WILD? JRNZ SCAN12 ;STORE CHAR IF NOT WILD MVI M,'?' ;STORE '?' AND DON'T ADVANCE COMMAND LINE PTR JR SCAN13 SCAN12: MOV M,A ;STORE CHAR IN FCBDN INX D ;PT TO NEXT CHAR IN COMMAND LINE SCAN13: DJNZ SCAN11 ;COUNT DOWN CHARS IN FILE TYPE (3 MAX) SCAN14: CALL SDELM ;SKIP REST OF CHARS AFTER 3-CHAR TYPE TO JRZ SCAN16 ; DELIMITER INX D JR SCAN14 SCAN15: INX H ;FILL IN REST OF TYP WITH MVI M,' ' DJNZ SCAN15 ; ; FILL IN EX, S1, S2, AND RC WITH ZEROES ; SCAN16: MVI B,4 ;4 BYTES SCAN17: INX H ;PT TO NEXT BYTE IN FCBDN MVI M,0 DJNZ SCAN17 ; ; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN ; SDED CIBPTR ; ; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP ; POP H ;GET PTR TO FCBDN IN HL LXI B,11 ;SCAN FOR '?' IN FILENAME.TYP (C=11 BYTES) SCAN18: INX H ;PT TO NEXT BYTE IN FCBDN MOV A,M CPI '?' JRNZ SCAN19 INR B ;B<>0 TO INDICATE '?' ENCOUNTERED SCAN19: DCR C ;COUNT DOWN JRNZ SCAN18 MOV A,B ;A=B=NUMBER OF '?' IN FILENAME.TYP ORA A ;SET ZERO FLAG TO INDICATE ANY '?' RET ; ; CMDTBL (COMMAND TABLE) SCANNER ; ON RETURN, HL PTS TO ADDRESS OF COMMAND IF CCP-RESIDENT ; ON RETURN, ZERO FLAG SET MEANS CCP-RESIDENT COMMAND ; CMDSER: LXI H,CMDTBL ;PT TO COMMAND TABLE MVI C,NCMNDS ;SET COMMAND COUNTER CMS1: LXI D,FCBFN ;PT TO STORED COMMAND NAME MVI B,NCHARS ;NUMBER OF CHARS/COMMAND (8 MAX) CMS2: LDAX D ;COMPARE AGAINST TABLE ENTRY CMP M JRNZ CMS3 ;NO MATCH INX D ;PT TO NEXT CHAR INX H DJNZ CMS2 ;COUNT DOWN LDAX D ;NEXT CHAR IN INPUT COMMAND MUST BE CPI ' ' JRNZ CMS4 RET ;COMMAND IS CCP-RESIDENT (ZERO FLAG SET) CMS3: INX H ;SKIP TO NEXT COMMAND TABLE ENTRY DJNZ CMS3 CMS4: INX H ;SKIP ADDRESS INX H DCR C ;DECREMENT TABLE ENTRY NUMBER JRNZ CMS1 INR C ;CLEAR ZERO FLAG RET ;COMMAND IS DISK-RESIDENT (ZERO FLAG CLEAR) ; ;**** Section 5 **** ; CCP-Resident Commands ; ; ;Section 5A ;Command: DIR ;Function: To display a directory of the files on disk ;Forms: ; DIR Displays the DIR files ; DIR S Displays the SYS files ; DIR A Display both DIR and SYS files ; DIR: MVI A,80H ;SET SYSTEM BIT EXAMINATION PUSH PSW CALL SCANER ;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN CALL SLOGIN ;LOG IN DRIVE IF NECESSARY LXI H,FCBFN ;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP MOV A,M ;GET FIRST CHAR OF FILENAME.TYP CPI ' ' ;IF , ALL WILD CZ FILLQ CALL ADVAN ;LOOK AT NEXT INPUT CHAR MVI B,0 ;SYS TOKEN DEFAULT JRZ DIR2 ;JUMP; THERE ISN'T ONE CPI SYSFLG ;SYSTEM FLAG SPECIFIER? JRZ GOTSYS ;GOT SYSTEM SPECIFIER CPI SOFLG ;SYS ONLY? JRNZ DIR2 MVI B,80H ;FLAG SYS ONLY GOTSYS: INX D SDED CIBPTR CPI SOFLG ;SYS ONLY SPEC? JRZ DIR2 ;THEN LEAVE BIT SPEC UNCHAGNED POP PSW ;GET FLAG XRA A ;SET NO SYSTEM BIT EXAMINATION PUSH PSW DIR2: POP PSW ;GET FLAG DIR2A: ;DROP INTO DIRPR TO PRINT DIRECTORY ; THEN RESTART CCP ; ; DIRECTORY PRINT ROUTINE; ON ENTRY, MSB OF A IS 1 (80H) IF SYSTEM FILES EXCL ; DIRPR: MOV D,A ;STORE SYSTEM FLAG IN D MVI E,0 ;SET COLUMN COUNTER TO ZERO PUSH D ;SAVE COLUMN COUNTER (E) AND SYSTEM FLAG (D) MOV A,B ;SYS ONLY SPECIFIER STA SYSTST CALL SEARF ;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE) CZ PRNNF ;PRINT NO FILE MSG;REG A NOT CHANGED ; ; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN ; DIR3: JRZ DIR11 ;DONE IF ZERO FLAG SET DCR A ;ADJME CALL SCANER ;EXTRACT FILENAME.TYP TOKEN JRNZ REN4 ;ERROR IF ANY '?' POP PSW ;GET OLD DEFAULT DRIVE MOV B,A ;SAVE IT LXI H,TEMPDR ;COMPARE IT AGAINST CURRENT DEFAULT DRIVE MOV A,M ;MATCH? ORA A JRZ REN2 CMP B ;CHECK FOR DRIVE ERROR MOV M,B JRNZ REN4 REN2: MOV M,B XRA A STA FCBDN ;SET DEFAULT DRIVE LXI D,FCBDN ;RENAME FILE MVI C,17H ;BDOS RENAME FCT CALL GRBDOS RNZ REN3: CALL PRNNF ;PRINT NO FILE MSG REN4: JMP ERRLOG ; ENDIF ;RAS ; ;Section 5G ;Command: USER ;Function: Change current USER number ;Forms: ; USER Select specified user number; is in DEC ; USER: CALL USRNUM ;EXTRACT USER NUMBER FROM COMMAND LINE MOV E,A ;PLACE USER NUMBER IN E CALL SETUSR ;SET SPECIFIED USER RSTJMP: JMP RCCPNL ;RESTART CCP ; ;Section 5H ;Command: DFU ;Function: Set the Default User Number for the command/file scanner ; (MEMLOAD) ;Forms: ; DFU Select Default User Number; is in DEC ; DFU: CALL USRNUM ;GET USER NUMBER STA DFUSR ;PUT IT AWAY JR RSTJMP ;RESTART CCP (NO DEFAULT LOGIN) ; ;Section 5I ;Command: JUMP ;Function: To Call the program (subroutine) at the specified address ; without loading from disk ;Forms: ; JUMP Call at ; is in HEX ; IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM ; JUMP: CALL HEXNUM ;GET LOAD ADDRESS IN HL JR CALLPROG ;PERFORM CALL ; ENDIF ;RAS ; ;Section 5J ;Command: GO ;Function: To Call the program in the TPA without loading ; loading from disk. Same as JUMP 100H, but much ; more convenient, especially when used with ; parameters for programs like STAT. Also can be ; allowed on remote-access systems with no problems. ; ;Form: ; GO ; IF NOT RAS ;ONLY IF RAS ; GO: LXI H,TPA ;Always to TPA JR CALLPROG ;Perform call ; ENDIF ;END OF GO FOR RAS ; ;Section 5K ;Command: COM file processing ;Function: To load the specified COM file from disk and execute it ;Forms: ; ; COM: LDA FCBFN ;ANY COMMAND? CPI ' ' ;' ' MEANS COMMAND WAS 'D:' TO SWITCH JRNZ COM1 ;NOT , SO MUST BE TRANSIENT OR ERROR LDA TEMPDR ;LOOK FOR DRIVE SPEC ORA A ;IF ZERO, JUST BLANK JZ RCCPNL DCR A ;ADJUST FOR LOG IN STA TDRIVE ;SET DEFAULT DRIVE CALL SETU0D ;SET DRIVE WITH USER 0 CALL LOGIN ;LOG IN DRIVE JMP RCCPNL ;RESTART CCP COM1: LDA FCBFT ;FILE TYPE MUST BE BLANK CPI ' ' JNZ ERROR LXI H,COMMSG ;PLACE DEFAULT FILE TYPE (COM) INTO FCB LXI D,FCBFT ;COPY INTO FILE TYPE LXI B,3 ;3 BYTES LDIR LXI H,TPA ;SET EXECUTION/LOAD ADDRESS PUSH H ;SAVE FOR EXECUTION CALL MEMLOAD ;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE ;(NO RETURN IF ERROR OR TOO BIG) POP H ;GET EXECUTION ADDRESS ; ; CALLPROG IS THE ENTRY POINT FOR THE EXECUTION OF THE LOADED ; PROGRAM;ON ENTRY TO THIS ROUTINE, HL MUST CONTAIN THE EXECUTION ; ADDRESS OF THE PROGRAM (SUBROUTINE) TO EXECUTE ; CALLPROG: SHLD EXECADR ;PERFORM IN-LINE CODE MODIFICATION CALL DLOGIN ;LOG IN DEFAULT DRIVE CALL SCANER ;SEARCH COMMAND LINE FOR NEXT TOKEN LXI H,TEMPDR ;SAVE PTR TO DRIVE SPEC PUSH H MOV A,M ;SET DRIVE SPEC STA FCBDN MVI A,10H ;OFFSET FOR 2ND FILE SPEC CALL SCAN1 ;SCAN FOR IT AND LOAD IT INTO FCBDN+16 POP H ;SET UP DRIVE SPECS MOV A,M STA FCBDM XRA A STA FCBCR LXI D,TFCB ;COPY TO DEFAULT FCB LXI H,FCBDN ;FROM FCBDN LXI B,33 ;SET UP DEFAULT FCB LDIR LXI H,CIBUFF COM4: MOV A,M ;SKIP TO END OF 2ND FILE NAME ORA A ;END OF LINE? JRZ COM5 CPI ' ' ;END OF TOKEN? JRZ COM5 INX H JR COM4 ; ; LOAD COMMAND LINE INTO TBUFF ; COM5: MVI B,0 ;SET CHAR COUNT LXI D,TBUFF+1 ;PT TO CHAR POS COM6: MOV A,M ;COPY COMMAND LINE TO TBUFF STAX D ORA A ;DONE IF ZERO JRZ COM7 INR B ;INCR CHAR COUNT INX H ;PT TO NEXT INX D JR COM6 ; ; RUN LOADED TRANSIENT PROGRAM ; COM7: MOV A,B ;SAVE CHAR COUNT STA TBUFF CALL CRLF ;NEW LINE CALL DEFDMA ;SET DMA TO 0080 CALL SETUD ;SET USER/DISK ; ; EXECUTION (CALL) OF PROGRAM (SUBROUTINE) OCCURS HERE ; EXECADR EQU $+1 ;CHANGE ADDRESS FOR IN-LINE CODE MODIFICATION CALL TPA ;CALL TRANSIENT CALL DEFDMA ;SET DMA TO 0080, IN CASE ;PROG CHANGED IT ON US CALL SETU0D ;SET USER 0/DISK CALL LOGIN ;LOGIN DISK JMP RESTRT ;RESTART CCP ; ;Section 5L ;Command: GET ;Function: To load the specified file from disk to the specified address ;Forms: ; GET Load the specified file at the specified page; ; is in HEX ; IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM ; GET: CALL HEXNUM ;GET LOAD ADDRESS IN HL PUSH H ;SAVE ADDRESS CALL SCANER ;GET FILE NAME POP H ;RESTORE ADDRESS JRNZ ERRJMP ;MUST BE UNAMBIGUOUS ; ; FALL THRU TO MEMLOAD ; ENDIF ;RAS ; ; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE ; ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD ; ; EXIT BACK TO CALLER IF NO ERROR. IF COM FILE TOO BIG OR MEMORY ; FULL, EXIT TO MLERR. ; MEMLOAD: SHLD LOADADR ;SET LOAD ADDRESS CALL GETUSR ;GET CURRENT USER NUMBER STA TMPUSR ;SAVE IT FOR LATER STA TSELUSR ;TEMP USER TO SELECT ; ; MLA is a reentry point for a non-standard CP/M Modification ; This is the return point for when the .COM (or GET) file is not found the ; first time, Drive A: is selected for a second attempt. ; MLA: CALL SLOGIN ;LOG IN SPECIFIED DRIVE IF ANY CALL OPENF ;OPEN COMMAND.COM FILE JRNZ MLA1 ;FILE FOUND - LOAD IT ; ; ERROR ROUTINE TO SELECT USER 0 IF ALL ELSE FAILS ; DFUSR EQU $+1 ;MARK IN-THE-CODE VARIABLE MVI A,DEFUSR ;GET DEFAULT USER TSELUSR EQU $+1 ;MARK IN-THE-CODE VARIABLE CPI DEFUSR ;SAME? JRZ MLA0 ;JUMP IF SO STA TSELUSR ;ELSE PUT DOWN NEW ONE MOV E,A CALL SETUSR ;GO SET NEW USER NUMBER JR MLA ;AND TRY AGAIN ; ; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED ; MLA0: LXI H,TEMPDR ;GET DRIVE FROM CURRENT COMMAND XRA A ;A=0 ORA M JRNZ MLERR ;ERROR IF ALREADY DISK A: MVI M,1 ;SELECT DRIVE A: JR MLA ; ; FILE FOUND -- PROCEED WITH LOAD ; MLA1: LOADADR EQU $+1 ;MEMORY LOAD ADDRESS (IN-LINE CODE MOD) LXI H,TPA ;SET START ADDRESS OF MEMORY LOAD ML2: MVI A,ENTRY/256-1 ;GET HIGH-ORDER ADR OF JUST BELOW CCP CMP H ;ARE WE GOING TO OVERWRITE THE CCP? JRC PRNLE ;ERROR IF SO PUSH H ;SAVE ADDRESS OF NEXT SECTOR XCHG ;... IN DE CALL DMASET ;SET DMA ADDRESS FOR LOAD LXI D,FCBDN ;READ NEXT SECTOR CALL READ POP H ;GET ADDRESS OF NEXT SECTOR JRNZ ML3 ;READ ERROR OR EOF? LXI D,128 ;MOVE 128 BYTES PER SECTOR DAD D ;PT TO NEXT SECTOR IN HL JR ML2 ; ML3: DCR A ;LOAD COMPLETE JZ RESETUSR ;IF ZERO, OK, GO RESET CORRECT USER ;# ON WAY OUT, ELSE FALL THROUGH TO PRNLE ; ; LOAD ERROR ; PRNLE: CALL PRINTC DB 'Ful','l'+80H ; ; TRANSIENT LOAD ERROR ; MLERR: CALL RESETUSR ;RESET CURRENT USER NUMBER ; RESET MUST BE DONE BEFORE LOGIN ERRLOG: CALL DLOGIN ;LOG IN DEFAULT DISK ERRJMP: JMP ERROR ; END  ---------------------------------------------------------------- !!8080 CPU?${ͅ; DCON Debugger$| }*|(=g.x( ~#bx( { ~#o}o0.!5!~# ~: #~= #~(~#('08' 80))))o">*20{(  ++ Reloc Ignored ++$ Ý=,y $ 1"! 6 # 5! w # 1A' KByQ180ɾ# * { #z +++ : 1>H2  ~@̿ #  —A #2 HXY": [! x1y! ~14: ]1: 1̈́: ]G: ]G: +-1x1>--x /<2>"! ͏1 y9191=: H1: H1m: HĄX>(5>ÿ* " : 1! x1yc͏Q! 6>!>* w#" /_~ X.X%! 6! 56>!w! ͏ªyƛc irڑ<ʢڱڵ<<(1ER[o{!!Z!Q* yoxg |1}ր!ͿQͿx@cGOc͸ͿZ7G91 <8 b=ÚGLyiÿ Z1cUyi<O cGͽO͵ycC×@O͵øcBG͵Lbi!͵O! vGy(×L¤: 1> : J ͬ C ͬͿyÝR1͏** {zX~#"  : >o&) N>[ ' +-/< ]: H%>X>YyO ~@' # - z8LO! ~ #~ - - L SP' * ! 0 * h!9" :2 !!"<<2 * ! X! ~(5X͌2 W!}p  pppv@jzOʂqme!zL! :W@!z8!6!L6* +" +V'W@!R=!V=ʽ=ʱz!p!5vL!Z6!n!Jz8!:Lrz2 WvvFjzpz Sz4==ʵz"\!ʋz:z!:z!v* #~v~!R!:n!CSJRSzʬ==ʵ!z=( 86n:nF!n!:L?!!:L!:Lz!5W_n!& 5 !N 5! 5  _W! :z 0 ?* !9" ͌" * " * 0 83  Ɛ':' '/7?v (08"*2:DEFGMOVW^_goSI@DLI@DPCI@SPI@XTI@DAD@OTDRINDRCCDRLDDROTIRINIRCCIRLDIROUTDIND CCD LDD OUTIINI CCI LDI RLD RRD LDARIM2 LDAIIM1 STARRETISTAIIM0 RETNNEG DSBCDADCINP OUTPSBCDLBCDSDEDLDEDSHLDLHLDSSPDLSPDRLCRRRCRRALRRARRSLARSRARSLLRSRLRBIT RES SET POP PUSHRST LXI INX DAD DCX STAXLDAXMVI INR DCR ADD ADC SUB SBB ANA XRA ORA CMP MOV CALLJMP LDA STA LHLDSHLDJRC JRNCJRZ JRNZJMPRDJNZCPI ORI XRI ANI SBI IN SUI OUT ACI ADI EI SPHLDI XCHGPCHLXTHLEXX RET HLT CMC STC CMA DAA RAR RAL RRC EXAFRLC NOP *"NZZ NCC POPEP M B C D E H L M A B D @ SP PSW DB 6 > ßüE7göa~.ñ" ! *"< !6 "!""!2 2 2 2 !" " "!" !"'!1!!++"!1!" *R")!s:22!:2%! 6 2&!R>28! "9:] (!%1!! ! 76 .>#ͼ (! 6- 5Aڱұ_! ^#Vz  H  aE)p"M.Uñů2[\6 >2 ! ""!Rұ : (k =±" Rұ(" =( "=±> 2 ڱʱ= =  ! !"#!(8" =( =± * }o[#!" .7 * " ~>:: (^#V#~͓8 ~#͓8} " : * ͆* } | * ͓ + ±{z͞ |±ʹ }2 .2 " " DM! 6(8"!=( l =(YPl ! ~(+#^#V: (*!{ z " ~62 #w6 1!1!*!*!! ~4(#~#F# x ~#s#r#w> =(#=±.~ᯕo>g~ .F>#z { 8<(>'{>' .*!6##V+^+N+y 5 .6~ 4~+(7 >: ->!2!w.!v:2!(!!:2!(!All regs displayed 8080 regs only Pre-trace display Post-trace display :&!ʱ (w!Rڱ!o& 6 User=!(:%!!>.!.0 Version !ex#y#* !}|@" !: !@ڱ!=: ( ± ! !|±"!! ~(#~#V z :!w  :!ʱ! ~ :!w#s#r  ñ! ~(: (6.~#^#VF !(=±"!!l !~# :]?X ʱ>HXE3*!y\6 |w# Jʱ: W_O { x!(i`"!<w# J±ͿͿGтWx!@8: k >ULT3! !\~# 2|:] ʘ!)X <ʱʘ!8_*! (  8*+ ( (!ڱw{ұ*#^#Vr+s+6@ұ*"s#s#r f!*!*"! .O(,I±=±2"! :"!>=Ox±Oy |±}.!3* !~*!~*+~. SYMBOLS NEXT PC END =±.~: k^#V~~ͼ (U. : >."  (w#- : >- +: (+=±: (s#r#±}w#: (#O>>2 !" #(8 }ʱ=( =±" " 2 :2!( u .͞ ʹ B E#7/ YY.~~ #   G ‰x'± cx/!ozd( !d K D.͝ͼ = +x0)| }0]gA>Ag} ñ | E~!!!!p ͆s#r O B!!3!?(N"(edO(: (Z(y (,( ( (21!ñ>21!(h"/!s(: (("( (_  ("("(s#h(±ѷRڱ")!"'!s.*'!~*)!~:1!*+!K-!:3!sK/!:1!G(4! h#"-!"+!+" !"#! | |7 ?+!!'!:[(_!~(![4\6 2[7.>?   6 ! " > > 4 6_6 ~#a_! eliminated. 3) The assembler/disassembler module is compatible with neither (see next section). 4) A bug that existed in ZSID through at least version 1.4 has been corrected. Specifically, this bug caused improper operation when tracing relative jumps (sign bit of the argument byte was improperly added to the program counter). 5) The stack-reference operator has been changed from the circumflex character ("^") to the dollar sign ("$") in order to accomodate the input radix specifier. (The stack operator was an undocumented feature of SID 1.4 -- see under "Expression Evaluator") 6) The "List Symbols" command ("H" with no arguments) now places four symbols on a line. 7) The "M" (move memory) command has been extended to allow over- lapping areas of memory to be moved. 8) The "S" command will now "back up"; if you enter a "-" character (must be on the line by itself), the "S" pointer will be decremented and the previous location will be opened. B) Z80 operation ================ The debugger has been upgraded to allow interpretation of Z80 opcodes. The format used for the assembler/disassembler module is that used by the TDL/XITAN/CDL/PASM series of assemblers, with one change:the index regesters are referenced by "[+offset]" rather than the "offset()" used by these assemblers. For example, loading reg. B from index register "X" offset by 6 would be "MOV B,[IX+06]" rather than "MOV B,6(X)", as it would be with the TDL series assemblers. Note that the leading zero in the offset constant is required. All Z80 instructions are understood by the trace commands, "T" and "U". Further, the Z80 registers are displayed in a two-line format, with the 8080 subset on the first line. This is similar to ZSID's display, except that the second line (Z80-specific registers only) can be disabled under command control (see under "New Commands"). I may someday add a ZILOG format assembler/disassembler module. C) Expression evaluator ======================= The expression evaluator has been significantly upgraded to allow new operations: 1) The multiplication ("*") and division ("/") operators are now allowed in any expression. Their precedence is one level higher than addition and subtraction. 2) The precedence of operations may be changed by using parentheses. For example, 2*3+4 will evaluate to 10, whereas 2*(3+4) will result in 14. 3) The indirect-word operator "@" has been extended to include the entire expression to the right of the op- erator; this operator formerly had effect only on sym- bols. For example, if location 5 contains a jump to 0DC06H, the command "D6" will display memory from loc. 6 onward, where "D@6" will display starting at DC06H. 4) The indirect-byte operator has been similarly extended. 5) The radix may be specified ahead of a numeric constant using the "^" operator. For example, "^H40" can be used to specify hexadecimal 40, "^D40" will spec- ify decimal 40, and "^B0101" specifies binary 0101 (dec- imal 5). Note that the "#" prefix is retained as a decimal specifer. Also, if no modifier is present, hex is assumed. 6) The stack may be referenced within an expression with the "$" symbol, which will retrieve stack items one level deep for each occurence of the symbol. For example, sup- pose the stack contains the following: 0D30H, 7206H, 6903H. Then "D$" will display starting at 0D30H, "G$$+1" will transfer control to location 7207H, and "H$$$" will display 6903H. This was an undocumented feature of SID version 1.4 (the symbol was "^"). D) New Commands =============== The following new commands have been added: 1) QUERY ("Q"): this is used to "query" I/O ports. The formats are: a. QIp - query inport port p, where p is any expression evaluating to 255 or less. b. QI - query the last input port accessed with the "QI" command. DCON's response is "pp=vv", where "pp" is the port number referenced. This is to remind you of the last port number accessed. Note that if no port has been previously accessed, port #0 is assumed. c. QOp,v - send the value "v" out to port # p 2) VERIFY ("V"): used to compare memory blocks. The format is Vs,e,d where s is the source address, e is the end of the source block, and d is the destination block to be compared to the source. If the two blocks match exactly, DCON will simply return to command level. Otherwise a list of the diffences will be printed. 3) SEARCH ("Y"): used to search for a string of up to 16 bytes/chars. The formats used are: YBs,e - set "s" as the search lower boundary, and "e" as the upper. Only this area will be searched. These value are initially set to include the entire TPA. Y - specifies the string to search for. This can be a quoted string, as "Yfoobar". It can also be made up of an expression list; for example, YC3,04,02,'B',#213,^B010101101. Strings and expr- essions can be intermixed. The "?" character can be used to specify a wild-card (matches anything). Note that lower-to-upper case translation is suppressed within quoted strings. YW - as above, except expressions are interp- reted as word values (quoted strings are still considered bytes. Y - Find next occurence of previous search string. In general, Y will find the first occurence of the search string, and display the matched string for a length of 16 bytes using the format of the "D" command. To find subsequent occurences, use more "Y" commands without arguments. When no reply is given, the search area contains no more occurences of the string. A subsequent "Y" will reset the search parameters to the beginning of the search area (i.e., the search will start over). The special forms "-Y" and "-Y" will suppress printing of the ascii equivalent of the found search string. The search string is not modified by the "YB" form. Some examples should illustrate the power of the search command: -- Y300,.TOPMEM sets search area to start at 300H and end at the value of the symbol .TOPMEM. -- YCD,?,?,"ZOT",CD,?,?,C3 will search for any call instruction (CD) followed by the string "ZOT", followed by another call instruction, followed by a jump instruction. -- YW.IFMAP,CD03,.GETCH,"bop",0FD3 will search for the WORDS .IFMAP, hex CD03, symbol .GETCH, string "bop", hex 0FD3. -- YDB,?,E6,?,C2 will search for an input routine of the form IN , ANI , jump not-zero. 4) NEXT (N): the N command allows convenient re-display of the loaded program/symbol parameters, "NEXT PC END". 5) VERSION (Z): displays the DCON version number 6) Extended commands: there are (currently) two "extended" commands, prefixed by the letter "E". a. USER ("EU"): changes/queries the CP/M 2.x user number. (not available under CPM 1.4 and 1.3). The format is EUn where n is the DECIMAL CONSTANT to set the user number to. If n is omitted, the current user number will be displayed. b. MODE ("EM"): there are (currently) two display modes supported - register display and trace display. The register display is normally two lines of registers, with the 8080 subset on the first line, the Z80 primes and index registers on the second line, followed by the PC and disassembled instruction. The command "EMR" can be used to toggle between this format and an abbreviated format consisting of only the 8080 register subset and the PC with disassembled instruction. Trace mode refers to WHEN the registers are displayed during tracing. The default condition for tracing is 1) display the registers * ROUTINE FOR READING TRS80 TRACK - READS EVERY SINGLE BIT * INTO MEMORY, IN ONE PASS. * * FROM MARV SASS 17 AUGUST 81 1035 HOURS ORG 7000H BUFF EQU 8000H ;Set buffer for storage at normal place. BEGIN LD HL,BUFF LD DE,00H LOOP LD A,4 LD (37E1H),A LD (37EEH),DE LD A,1BH LD (37ECH),A CALL DELAY CALL WAIT LD A,0E4H CALL DELAY LOOP1 LD A,(37ECH) BIT 1,A JR Z,LOOP1 LF A,(37EFH) LD (HL),A INC HL LD A,(37ECH) BIT 0,A JR NZ,LOOP1 INC D LD A,D CP 4 JP Z,402DH JR LOOP DELAY LD B,6 DELAY1 DJNZ DELAY1 RET WAIT LD A,(37ECH) BIT 0,A JR NZ,WAIT RET END BEGIN !9" 1 >2$ 2% : 2& 20 24 !]~ <K+ >20 1 !\6 6#Y!] ~?#e!e:] >2% 2$ \ | 2%  \2$ \ͥ:0 3ͥ bh |7 72%  hN2$ hͥ? >2/ !\6#6?#p6#ƒ\ͦ\•`!o|g#~#·> :/ =2/ bz!v "1 \ͥ1 >25 !v ~:T:4 ñͥ*   :4 9 .ʥ^ʱ@G`iX `*, {T~#ʜ ʏ {#~:q{{:$ ʸ_>2$ :% _ >2% a{__ ~#\*1 :& XT*1 ~#I3 S6#I"1 n ~ z {|#a##:. =2. ~w:5 <25 :4 ʨM.ʥ^ʱLS") *' >25  Ë+~:5 ==25 > > >2. >25 !v >A2+ ~:P :+ <2+ >.> a(", "' !") ~w >25 a~ʓ:ʓ i#ͅi:. G|‰~w:. =2. —:5 <25 :4 M.ʥ^ʱLS *' >25 i äi*' *) z{25 #~+::4 :## !] :4 <24  ]o>.oK~#.ʚ!ښo~#.! O> ›y:4 >:4 ? =24  ~ ##>.~#] K6 o&]T))):4 6 :4 E :5 E 23 dZ Z0d \G:3 zy23 z> }y0xHELP Version 2.0 $ HELP File Selections are -- $HELP HLPEOI ^C=CP/M $^=Level .=Root $M=Menu S=Start L=Last CR=Next $ HELP FATAL ERROR -- File Name Contains Wild Card$ HELP FATAL ERROR -- File not Found$ HELP ERROR -- Invalid Response $ HELP ERROR -- EOF on HELP File $ HELP ERROR -- Not Possible to Backup Before Start of Info $ HELP ERROR -- Node Level Limit Reached -- Aborting $ HELP ERROR -- Invalid File Name in Load $ HELP ERROR -- No Higher Level to Return to $ HELP ERROR -- Not Enough Room for HELP File $ HELP ERROR -- HELP File NOT Terminated by ^Z $Level $/ $: $Type ^C=CP/M$ ^=Level .=Root$ or Enter Selection $ Loading HELP File $nvalid File Name in Load $ HELP ERROR -- No Higher Level to Return to $ HELP ERROR -- Not Enough Room for HELP File $ HELP ERROR -- HELP File NOT Terminated by ^Z $Level $/ $: $Type ^C=CP/M$ ^=Level .=R Default HELP Facility Invoked Names of Available HLP Files are -- $ Type Any Char for Default Information (^C=Abort) -- $:The HELP Subsystem for Online Documentation This is HELP, the Online Documentation Subsystem. The purpose of HELP is to allow the user to interactively query the *.HLP files of the system in order to receive information summaries on various aspects of the user's working environment, such as the language systems he is using and certain subsystems available to him. When the user types 'HELP', a search is done for the file 'HELP.HLP'. If found, its contents are to the user; if not found, this message is displayed. If the user desires information on a specific topic and he has a HELP File of that name (ie, CPM.HLP is a HELP File on CP/M), he may issue of HELP Command of the form -- HELP d:topic where "d:" is the disk the HELP File resides on (optional) and "topic" is the name of the HELP File (topic.HLP, like CPM.HLP). Please refer to the HELP File "HELP.HLP" for more information. 1:=W!~# xb{,~#o}o5 x!. Ë,y$ K <! 6 # )! wK# <5KByE<80ɾ# d * {~#z +++ r : <>H2 ~@̸¬#™ ŽA #2HXY: [! m<y!~<4: ]<: <~: G: G: $-<x<>--x,/<2>! ͆< y3<3<=:H<:H<g:H~X>ʺ>ú* " : <! m<yW͊E!6>!>*w#"/_~úK d.d!6!56>ú!w! ͆¬yƛ` foڎ<ʟڮڳ<ʾ<(2FS\p|!|!N!E*yoxg |<}ր!ͺEͺx@WGäOWͶͺN7G3<< \=×GFs]ú N<WOs]<O 7WG͸OͰyWCÔ@OͰöWBGͰF\]!ͰO! pGyʕÔF¦:<> : J¼ͧCͧͺyÚR<͊**{zd~#": >o&) N>[$/$+$-/<̈́]:H%>X>YyO ~@/$#D"z8UO! ~$#~$""U‹SP/$͞*ͷq!9"2!!"<<2*!ͨd!~5d͖2W!id d dd|@ozSʇwrj!zU‹! BW@!fr!>!U>*+"+V2W@!>=!B==ʶz!d!={U!F>!w!6z@!BUÍz2Wv{Fozpz Xz4==ʾz"a!ʑz>z!Bz!{*#~{~!V!Bw!C\JlR\zʵ==ʾ!z=ʩڣ>wBw!w!BU!!BU!BUz!=