TITLE 'OCP RESIDENT COMMAND PROCESSOR' VERSION EQU 14 SUBVER EQU 5 ; Version 1.45 ;--------------------------------------------------- ; DEFINITIONS, MACROS, AND OPTIONS LIBRARIES MACLIB SYSDEF ; Common logic, sys, ascii defines MACLIB Z3BASE ; Needed for Z3WHL address MACLIB Z80MAC ; Defines z80 command macros MACLIB OCP ; Defines command options ;DEFINITIONS UNIQUE TO THIS PROGRAM DIRBUF EQU 4800H ; Dir buffer (many entries permitted) ;PAGCNT EQU DIRBUF-100H ; Page count buffer ;OLDFCB EQU PAGCNT+1 ; Old fcb buffer ; SYSTEM Entry Point ORG 4000H ; BGii OCP address DB 'OCP' ; Flag for package loader DB '1' ; OCP ID character DB 0FFH ; Non-zero to save OCP in swap file on exit ; Command Table CNSIZE EQU CMDLEN ; Number of chars in command name DB CNSIZE ; Size of text entries IF HBSWHL CTAB: COMMAND H,' ',TRUE,WHRC,CLIST ; Help for rcp CTAB1: COMMAND C,'P ',CPON,WCP,COPY ; Copy COMMAND D,'IR ',DIRON,WDIR,DIR ; Directory COMMAND E,'CHO ',ECHOON,FALSE,ECHO ; Echo COMMAND E,'RA ',ERAON,WERA,ERA ; Erase COMMAND P,'ORT ',PORTON,WPORT,PORT ; I/o port read and write COMMAND P,'ROT ',PROTON,WPROT,ATT ; Protection codes COMMAND R,'EG ',REGON,WREG,REGISTER ; Register command COMMAND R,'EN ',RENON,WREN,REN ; Rename COMMAND S,'P ',SPACEON,FALSE,SPACE ; Space COMMAND T,'ST ',TSTON,FALSE,TESTERR ; Error testing ELSE ; Not HBSWHL CTAB: HELPCMD ; Macro to provide name of help command DW CLIST CTAB1: IF CPON CPCMD ; Macro to provide name of copy command DW COPY ENDIF ; Cpon IF DIRON DIRCMD ; Macro to provide name of directory command DW DIR ENDIF ; Diron IF ECHOON ECHOCMD ; Macro to provide name of echo command DW ECHO ENDIF IF ERAON ERACMD ; Macro to provide name of erase command DW ERA ENDIF ; Eraon IF PORTON PORTCMD ; Macro to provide name of port command DW PORT ENDIF ; Porton IF PROTON PROTCMD ; Macro to provide name of protect command DW ATT ENDIF ; Proton IF REGON REGCMD ; Macro to provide name of register command DW REGISTER ENDIF ; Rseton IF RENON RENCMD ; Macro to provide name of rename command DW REN ENDIF ; Renon IF SPACEON SPACECMD ; Macro to provide name of space command DW SPACE ENDIF ; Spaceon IF TSTON TESTCMD ; Macro to provide name of error testing command DW TESTERR ENDIF ENDIF ; Hbswhl DB 0 ; Marks end of command jump table ; BANNER NAME OF RCP RCP$NAME: RCPNM ; Name of this rcp plus trailing blank ; From sysrcp.lib DB (VERSION/10)+'0','.',(VERSION MOD 10)+'0' DB SUBVER + '0' DB RCPID ; From sysrcp.lib DB 0 ; ; Command List Routine ; CLIST: ; print the RCP-resident command names CALL CRLF LXI H,RCP$NAME ; Print rcp name CALL PRINT1 LXI H,CTAB1 ; Point to rcp command table MVI A,CNSIZE CLIST0: MOV E,A ; Save command name size MVI D,0 MVI C,1 ; New line CLIST1: MOV A,M ; Done? ORA A RZ DCR C ; Count down JRNZ CLIST1A CALL CRLF ; New line MVI C,4 ; Set count CLIST1A: MOV B,E ; Number of chars IF NOSHOW AND HBSWHL ; Option to suppress wheel-limited cmds MOV A,M RAL ; Shift wheel flag into carry bit JRNC CLIST2 ; If not restricted, go on LDA Z3WHL ; Otherwise, check wheel byte ORA A JRNZ CLIST2 ; If on, continue as usual DAD D ; Skip to end of entry INR C ; Don't count this command name JR CLIST3 ENDIF ; NOSHOW AND HBSWHL CLIST2: CALL PRINT ; Print spaces DB ' ',' '+80H CLIST2A: MOV A,M ; Get char CALL CONOUT ; Print INX H ; Pt to next DJNZ CLIST2A CLIST3: INX H ; Skip to next entry INX H JMPR CLIST1 ; Console Output Routine CONOUT: PUSH H ; Save regs PUSH D PUSH B PUSH PSW ANI 7FH ; Mask msb MOV E,A ; Char in e MVI C,2 ; Output CALL BDOS POP PSW ; Get regs POP B POP D POP H ; This simple return doubles for the NOTE Command (NOP) and CONOUT Exit ; NOTE Command: NOTE any text NOTE: RET ; Print String (terminated in 0 or MSB Set) at Return Address PRINT: XTHL ; Get address CALL PRINT1 XTHL ; Put address RET ; Print String (terminated in 0 or MSB Set) pted to by HL PRINT1: MOV A,M ; Done? INX H ; Pt to next ORA A ; 0 terminator RZ CALL CONOUT ; Print char RM ; Msb terminator JMPR PRINT1 ; **** OCP Routines **** ;Command: RESET ;Function: To reset the disk system to force relogging in of disks ;Comments: ZRDOS does not require a disk system reset when disks are ; changed, but directory programs will not show the correct ; size if this is not done. IF RESON RESET: MVI C,13 ; Disk reset bdos function IF RESMSG CALL BDOS ; Reset disk system CALL PRINT ; Report action DB 'rese','t'+80H RET ELSE ; Not resmsg JMP BDOS ; Call bdos and return ENDIF ; Resmsg ENDIF ; Reson ;Command: TST ;Function: To set the message buffer program error flag based on ; error count reported by ZAS, M80, or L80 ;Forms: TST PN where PN is first letter of ZAS, M80, or L80 IF TSTON ; Equates for addresses where error counts are kept by the programs to be tested ; M80/f80, version 3.44 M80F EQU 03CEDH ; Addr of word with fatal error count (m80) M80W EQU 03CEFH ; Addr of word with warning error count (m80) F80F EQU 001C1H ; Addr of word with fatal error count (f80) F80W EQU 002ADH ; Addr of word with warning error count (f80) ; Zas version 2.0 ZASF EQU 010AAH ; Addr of word with fatal error count (zas) TESTERR: IF Z3MSG EQ 0 ; If no message buffer, give error message *** ERROR *** THIS CODE CANNOT BE USED UNLESS THE ZCPR3 MESSAGE BUFFER IS IMPLEMENTED ELSE ; Generate code ; Check for name of program to test LDA FCB1+1 ; Get first character in command tail IF TESTM80 LXI H,M80F ; Preset for m80 test counts LXI D,M80W CPI 'M' JRZ TESTCOUNT ENDIF ; Testm80 IF TESTF80 LXI H,F80F LXI D,F80W CPI 'F' JRZ TESTCOUNT ENDIF ; Testf80 IF TESTZAS LXI H,ZASF MOV D,H ; Use zasf twice (shorter code) MOV E,L ; Since zas has only one count CPI 'Z' JRZ TESTCOUNT ENDIF ; Testzas ; If no match, give error message CALL PRINT BADTAILMSG: DB 'bad nam' DB 'e' OR 80H TESTCOUNT: MOV A,M ; Test first error count word INX H ORA M XCHG ; Test second word ORA M INX H ORA M LXI H,Z3MSG+6 ; Point to program error flag MVI M,0 ; Clear it RZ ; If counts were zero, we are done MVI M,0FFH ; Else set the error flag RET ENDIF ; Z3msg ENDIF ; Tston ;Command: SP ;SPACE shows space remaining on logged drive IF SPACEON IF (ERASP OR CPSP OR DIRSP) CRSPACE: ; Used to call space after other subroutines ; CALL CRLF ; (e.g., cp, era) ENDIF ; (erasp or cpsp or dirsp) SPACE: CALL CRLF GETDSK: LDA FCB1 ORA A ; Drive explicitly selected? JRNZ SKIP ; Yes MVI C,25 CALL BDOS ; Get current disk JMPR SKIP2 SKIP: DCR A ; Subtract 1 from a SKIP2: MOV E,A ADI 65 STA SELDRV ; Save drive letter for message MVI C,14 ; Select disk CALL BDOS ; Not needed if no drive selected, but smallest ; Possible code size this way. ; THIS ROUTINE EXTRACTS DISK PARAMETER INFORMATION FROM THE DPB AND ; STORES THIS INFORMATION IN: ; BLKSHF <-- BLOCK SHIFT FACTOR (1 BYTE) ; BLKMAX <-- MAX NUMBER OF BLOCKS ON DISK (2 BYTES) DPARAMS: ; VERSION 2.x OR MP/M MVI C,31 ; 2.x or mp/m...request dpb CALL BDOS INX H INX H MOV A,M ; Get block shift STA BLKSHF ; Block shift factor INX H ; Get block mask INX H INX H MOV E,M ; Get max block number INX H MOV D,M XCHG INX H ; Add 1 for max number of blocks SHLD BLKMAX ; Maximum number of blocks ; PARAMETERS EXTRACTED ; COMPUTE AMOUNT OF FREE SPACE LEFT ON DISK ; THE DPARAMS ROUTINE MUST BE CALLED BEFORE THIS ROUTINE IS USED DFREE: MVI C,27 ; Get address of allocation vector CALL BDOS XCHG BLKMAX EQU $+1 LXI H,0 ; Get length of allocation vector LXI B,0 ; Init block count to 0 ; BC IS ACCUMULATOR FOR SPACE FREE1: PUSH D ; Save alloc address LDAX D ; Get bit pattern of allocation byte MVI E,8 ; Set to process 8 blocks FREE2: RAL ; Rotate allocated block bit into carry flag JRC FREE3 ; If set (bit=1), block is allocated INX B ; If not set, block is not allocated, so increment ; Free block count FREE3: MOV D,A ; Save remaining allocation bits in d DCX H ; Count down number of blocks on disk MOV A,L ORA H JRZ FREE4 ; Done if no more blocks left MOV A,D ; A=current allocation bit pattern DCR E ; Have all 8 bits been examined? JRNZ FREE2 ; Continue if not POP D ; Get pointer to allocation vector INX D ; Point to next allocation byte JMPR FREE1 ; Continue by processing next allocation byte ; BC = TOTAL AMOUNT OF FREE SPACE IN TERMS OF BLOCKS FREE4: POP D ; Clear de from stack MOV L,C ; Hl=bc=number of free blocks MOV H,B BLKSHF EQU $+1 MVI A,0 ; Get block shift factor SUI 3 ; Convert number of blocks to k JRZ FREE6 ; Done if single density (1k per block) ; WE ARE AT A MORE ADVANCED DENSITY LEVEL; MULTIPLY THE NUMBER OF BLOCKS ; BY THE SIZE OF A BLOCK IN K FREE5: DAD H ; 2, 4, 8, 16, etc k/blk, so block shift factor DCR A ; Is a power-of-two multiple JRNZ FREE5 ; AT THIS POINT, HL=AMOUNT OF FREE SPACE ON DISK IN K FREE6: DECOUT: ; Output free space in decimal CALL PRINT DB ' Space on ' SELDRV: DB 0 DB ':',(' '+80H) MVI B,0 LXI D,10000 CALL DECD LXI D,1000 CALL DECD LXI D,100 CALL DECD MVI E,10 CALL DECD MOV A,L ADI '0' ; Ascii bias CALL CONOUT MVI A,'k' JMP CONOUT ; Final return from space routine ENDIF ; Spaceon ;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 ;Notes: ; The flag SYSFLG defines the letter used to display both DIR and ; SYS files (A in the above Forms section) ; The flag SOFLG defines the letter used to display only the SYS ; files (S in the above Forms section) ; The flag WIDE determines if the file names are spaced further ; apart (WIDE=TRUE) for 80-col screens ; The flag FENCE defines the character used to separate the file ; names IF DIRON DIR: ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED IF WDIR AND NOT HBSWHL CALL WHLTST ENDIF ; Wheel approval CALL RETSAVE ; Save ret address and set stack LXI H,FCB1+1 ; Make fcb wild (all '?') if no filename.typ MOV A,M ; Get first char of filename.typ IF SLASHCHK ; Option to allow "DIR /S" format CPI '/' JRNZ DIR01 ; Not slash, so process normally INX H ; Get option after slash MOV A,M STA FCB2+1 ; Put it into second fcb DCX H MVI A,' ' ; Simulate empty fcb ENDIF ; Slashchk DIR01: CPI ' ' ; If , all wild MVI B,11 ; Number of chars in fn & ft MVI A,'?' ; Prepare to store '?' CZ FILLP ; Fill with "?" if no file name IF NOSYS ; Suppress-sys-file-if-no-wheel option LDA Z3WHL ; Get wheel byte ORA A JRZ DIRNLY ; If wheel off, ignore options ENDIF LDA FCB2+1 ; Get first char of 2nd file name MVI B,1 ; Set for both dir and sys files CPI SYSFLG ; System and dir flag specifier? JRZ DIRPR ; Got system specifier DCR B ; B=0 for sys files only CPI SOFLG ; Sys only? JRZ DIRPR DIRNLY: MVI B,80H ; Must be dir-only selection ; DIRECTORY PRINT ROUTINE; ON ENTRY, B REG IS SET AS FOLLOWS: ; 0 FOR ONLY SYSTEM FILES, 80H FOR ONLY DIR FILES, 1 FOR BOTH DIRPR: MOV A,B ; Get systst flag CALL GETDIR ; Load and sort directory JZ PRFNF ; Print no file message MVI E,4 ; Count down to 0 ; ENTRY PRINT LOOP; ON ENTRY, HL PTS TO FILES SELECTED (TERMINATED BY 0) ; AND E IS ENTRY COUNTER DIR3: MOV A,M ; Check for done ORA A IF DIRSP AND SPACEON JZ SPAEXIT ; Show space when done ELSE JZ EXIT ; Exit if done ENDIF ; Dirsp and spaceon MOV A,E ; Get entry counter ORA A ; Output if 4 entries printed in line JRNZ DIR3A ; Continue CALL CRLF ; New line MVI E,4 ; Reset entry count MOV A,E ; Get entry count DIR3A CPI 4 ; First entry? JRZ DIR4 CALL PRINT IF WIDE DB ' ' ; 2 spaces DB FENCE ; Then fence char DB ' '+80H ; Then 1 more space ELSE DB ' ' ; Space DB FENCE+80H ; Then fence char ENDIF ; Wide DIR4: CALL PRFN ; Print file name CALL BREAK ; Check for abort DCR E ; Decrement entry counter JMPR DIR3 ENDIF ; Diron ;Command: ERA ;Function: Erase files ;Forms: ; ERA Erase Specified files and print their names ; ERA I Erase Specified files and print their names, but ask ; for verification before Erase is done IF ERAON ERA: ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED IF WERA AND NOT HBSWHL CALL WHLTST ENDIF ; Wheel approval CALL RETSAVE LDA FCB2+1 ; Get eraflg if it's there STA ERAFLG ; Save it as a flag MVI A,1 ; Dir files only CALL GETDIR ; Load directory of files JZ PRFNF ; Abort if no files ; MAIN ERASE LOOP ERA1: CALL BREAK ; See if user wants to stop PUSH H ; Save ptr to file CALL PRFN ; Print its name SHLD NXTFILE ; Save ptr to next file POP H ; Get ptr to this file CALL ROTEST ; Test file pted to by hl for r/o JRNZ ERA3 ERAFLG EQU $+1 ; Address of flag MVI A,0 ; 2nd byte is flag CPI 'I' ; Is it an inspect option? JRNZ ERA2 ; Skip prompt if it is not CALL ERAQ ; Erase? JRNZ ERA3 ; Skip if not ERA2: LXI D,FCB1+1 ; Copy into fcb1 MVI B,11 ; 11 bytes CALL BLKMOV CALL INITFCB1 ; Init fcb MVI C,19 ; Delete file CALL BDOS ERA3: LHLD NXTFILE ; Hl pts to next file MOV A,M ; Get char ORA A ; Done? IF ERASP AND SPACEON JZ SPAEXIT ELSE JZ EXIT ENDIF ; Erasp and spaceon CALL CRLF ; New line JMPR ERA1 ENDIF ; Eraon ;Command: PROT ;Function: To set the attributes of a file (R/O and SYS) ; ;Form: ; PROT afn RSI ;If either R or S are omitted, the file is made R/W or DIR, resp; ;R and S may be in any order. If I is present, Inspection is enabled. ; IF PROTON ATT: ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED IF WPROT AND NOT HBSWHL CALL WHLTST ENDIF ; Wheel approval CALL RETSAVE CALL CRLF XRA A ; Set no inspect STA INSPECT LXI H,0 ; Set r/o and sys attributes off LXI D,FCB2+1 ; Pt to attributes MVI B,3 ; 3 chars max ATT1: LDAX D ; Get char INX D ; Pt to next CPI 'I' ; Inspect? JRZ ATTI CPI 'R' ; Set r/o? JRZ ATTR CPI 'S' ; Set sys? JRZ ATTS ATT2: DJNZ ATT1 JMPR ATT3 ATTI: STA INSPECT ; Set flag JMPR ATT2 ATTR: MVI H,80H ; Set r/o bit JMPR ATT2 ATTS: MVI L,80H ; Set sys bit JMPR ATT2 ATT3: SHLD FATT ; Save file attributes MVI A,1 ; Select dir and sys files CALL GETDIR ; Load directory JZ PRFNF ; No file error JMPR ATT5 ATT4: LHLD NXTFILE ; Pt to next file MOV A,M ; End of list? ORA A JZ EXIT CALL CRLF ; New line ATT5: CALL BREAK ; Check for possible abort PUSH H ; Save ptr to current file CALL PRFN ; Print its name SHLD NXTFILE ; Save ptr to next file CALL PRINT DB ' Set to R','/'+80H LHLD FATT ; Get attributes MVI C,'W' ; Assume r/w MOV A,H ; Get r/o bit ORA A JRZ ATT6 MVI C,'O' ; Set r/o ATT6: MOV A,C ; Get char CALL CONOUT MOV A,L ; Get sys flag ORA A ; Set flag JRZ ATT7 CALL PRINT DB ' and SY','S'+80H ATT7: INSPECT EQU $+1 ; Ptr for in-the-code modification MVI A,0 ; Get inspect flag ORA A ; Z=no POP H ; Get ptr to current file JRZ ATT8 CALL ERAQ1 ; Ask for y/n JRNZ ATT4 ; Advance to next file if not y ATT8: LXI D,FCB1+1 ; Copy into fcb1 MVI B,11 ; 11 bytes CALL BLKMOV FATT EQU $+1 ; Ptr for in-the-code modification LXI H,0 ; Get attributes DCX D ; Pt to sys byte DCX D MOV A,L ; Get sys flag CALL ATTSET ; Set attribute correctly DCX D ; Pt to r/o byte MOV A,H ; Get r/o flag CALL ATTSET LXI D,FCB1 ; Pt to fcb MVI C,30 ; Set attributes CALL BDOS JMPR ATT4 ATTSET: ORA A ; 0=clear attribute JRZ ATTST1 LDAX D ; Get byte ORI 80H ; Set attribute STAX D RET ATTST1: LDAX D ; Get byte ANI 7FH ; Clear attribute STAX D RET ENDIF ; Proton ;Command: CP ;Function: To copy a file from one place to another ; ;Form: ; CP new=old ; IF CPON CPYADR EQU 4800H ; Copy in second half of OCP space CPYBLKS EQU 16 ; Buffer is 16 records (2K) up to 4FFFH COPY: ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED IF WCP AND NOT HBSWHL CALL WHLTST ENDIF ; Wheel approval CALL RETSAVE ; STEP 0: IF NEW IS BLANK, MAKE IT THE SAME NAME AND TYPE AS OLD LXI D,FCB1+1 ; Pt to new file name LDAX D ; Get first char CPI ' ' ; No name? JRNZ COPY0 LXI H,FCB2+1 ; Make same as old MVI B,11 ; 11 bytes CALL BLKMOV ; STEP 1: SEE IF NEW=OLD AND ABORT IF SO COPY0: LXI H,FCB1 ; Pt to new LXI D,FCB2 ; Pt to old PUSH H ; Save ptrs PUSH D INX H ; Pt to file name INX D MVI B,13 ; Compare 13 bytes COPY1: CALL COMP JRNZ COPY2 MVI C,25 ; Get current disk CALL BDOS INR A ; Make 1..p MOV B,A ; Current disk in b POP D ; Get ptr to dn POP H LDAX D ; Get disk MOV C,A ; In c ORA A ; Current? JRNZ COPY1A MOV C,B ; Make c current COPY1A: MOV A,M ; Get disk ORA A ; Current? JRNZ COPY1B MOV A,B ; Make a current COPY1B: CMP C ; Same disk also? JRNZ COPY3 ; Continue with operation JMPR CPERR COPY2: POP D ; Get ptrs POP H ; STEP 2: SET USER NUMBERS COPY3: LDA FCB1+13 ; Get new user STA USRNEW LDA FCB2+13 ; Get old user STA USROLD ; STEP 3: OPEN OLD FILE LXI H,OLDFCB ; Copy old into 2nd fcb PUSH H ; Save ptr to 2nd fcb XCHG MVI B,12 ; 12 bytes CALL BLKMOV CALL LOGOLD ; Log in user number of old fcb POP H ; Get ptr to 2nd fcb CALL INITFCB2 ; Init fcb MVI C,15 ; Open file CALL BDOS INR A ; Check for error JZ PRFNF ; File not found ; STEP 4: SEE IF NEW EXISTS CALL LOGNEW ; Log into new's user area CALL EXTEST ; Test JZ EXIT ; Error exit ; STEP 5: CREATE NEW LXI D,FCB1 ; Pt to fcb MVI C,22 ; Make file CALL BDOS INR A ; Error? JRNZ COPY5 ; COPY ERROR CPERR: CALL PRINT DB ' Copy','?'+80H JMP EXIT ; STEP 6: COPY OLD TO NEW WITH BUFFERING COPY5: CALL LOGOLD ; Get user MVI B,0 ; Set counter LXI H,CPYADR ; Beginning of copy buffer COPY5A: PUSH H ; Save address and counter PUSH B LXI D,OLDFCB ; Read block from file MVI C,20 CALL BDOS POP B ; Get counter and address POP D ORA A ; Ok? JRNZ COPY5B PUSH B ; Save counter LXI H,TBUFF ; Copy from buffer MVI B,128 ; 128 bytes CALL BLKMOV XCHG ; Hl pts to next POP B ; Get counter INR B ; Increment it MOV A,B ; Done? CPI CPYBLKS ; Done if cpyblks already loaded JRNZ COPY5A COPY5B: MOV A,B ; Get count ORA A JRZ COPY6 ; Done if nothing loaded PUSH B ; Save count CALL LOGNEW ; Get user LXI H,CPYADR ; Point to start of buffer again COPY5C: LXI D,TBUFF ; Copy into tbuff MVI B,128 ; 128 bytes CALL BLKMOV PUSH H ; Save ptr to next LXI D,FCB1 ; Pt to fcb MVI C,21 ; Write block CALL BDOS ORA A JRNZ CPERR ; Copy error POP H ; Get ptr to next block POP B ; Get count DCR B ; Count down JRZ COPY5 ; Get next PUSH B ; Save count JMPR COPY5C ; STEP 7: CLOSE OUTPUT FILE COPY6: CALL LOGNEW ; Get user LXI D,FCB1 ; Pt to fcb MVI C,16 ; Close file CALL BDOS CALL PRINT DB ' Don','e'+80H IF CPSP AND SPACEON JMP SPAEXIT ELSE JMP EXIT ENDIF ; Cpsp and spaceon ; LOG INTO USER NUMBER OF OLD FILE LOGOLD: USROLD EQU $+1 ; Pointer for in-the-code modification MVI A,0 ; Get number JMP SETUSR ; LOG INTO USER NUMBER OF NEW FILE LOGNEW: USRNEW EQU $+1 ; Pointer for in-the-code modification MVI A,0 ; Get number JMP SETUSR ENDIF ; Cpon ;Command: PORT ;Function: Display or Set I/O Port Data ; ;Form: ; PORT addr - read port and display value ; PORT addr value - output value to port IF PORTON PORT: ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED IF WPORT AND NOT HBSWHL CALL WHLTST ENDIF ; Wheel approval CALL RETSAVE CALL CRLF LXI H,TBUFF+1 ; Find first number CALL SKSP ; Skip to first command-line token JRZ NOARGS ; Abort if no port address given CALL HEXNUM ; Get start address into de PUSH H ; Save pointer to command tail LXI H,PADDR+1 ; Modify code MOV M,E ; Move specified port addr into place DCX H ; Point to opcode position MVI M,0DBH ; Poke 'in' opcode XTHL ; Get tail pointer back while saving this one CALL PRINT ; Print header DB ' Por','t'+80H MOV A,E CALL PASHC ; Print port address CALL SKSP ; Skip to possible second value JRZ PORTIN ; Proceed with port input CALL HEXNUM ; Get 2nd number in de XTHL ; Get pointer to opcode back MVI M,0D3H ; Poke 'out' opcode CALL PRINT DB ': OU','T'+80H MOV A,E ; Get value to output JMPR PADDR PORTIN: CALL PRINT DB ': I' 'N'+80H PADDR: IN 0 ; Modified by code above CALL PASHC POP H ; Clean up stack JMP EXIT ; PRINT A AS 2 HEX CHARS ; PASHC - LEADING SPACE PASHC: PUSH PSW ; Save a CALL PRINT DB ' '+80H POP PSW PAHC: PUSH B ; Save bc MOV C,A ; Byte in c RRC ; Exchange nybbles RRC RRC RRC CALL PAH ; Print hex char MOV A,C ; Get low POP B ; Restore bc and fall thru to pah PAH: ANI 0FH ; Mask ADI '0' ; Convert to ascii CPI '9'+1 ; Letter? JRC PAH1 ADI 7 ; Adjust to letter PAH1: JMP CONOUT NOARGS: CALL PRINT DB ' Arg','?'+80H JMP EXIT ENDIF ; Porton ;Command: REG ;Function: Manipulate Memory Registers ; ;Forms: ; REG D or REG <-- Display Register Value ; REG Mreg <-- Decrement Register Value ; REG Preg <-- Increment Register Value ; REG Sreg value <-- Set Register Value IF REGON REGISTER: IF WREG AND NOT HBSWHL ; If wheel check CALL WHLTST ENDIF ; Wreg CALL CRLF LXI D,FCB1+2 ; Pt to first arg LDAX D ; Get possible digit CALL REGPTR ; Pt to register DCX D ; Pt to command LDAX D ; Get command CPI 'S' ; Set? JRZ RSET CPI 'P' ; Plus? JRZ RINC CPI 'M' ; Minus? JRZ RDEC ; SHOW REGISTER VALUES RSHOW: XRA A ; Select register 0 MOV B,A ; Counter set to 0 in B CALL REGP2 ; HL pts to register 0 RSHOW1: MOV A,B ; Get counter value CPI 10 JZ CRLF ; New line and exit if done CALL PRINT DB ' Reg',' '+80H MOV A,B ; Print register number ADI '0' CALL CONOUT CALL PRINT DB ' ','='+80H PUSH B ; Save counter PUSH H ; Save pointer CALL REGOUT1 ; Print register value (no error flag setting) POP H ; Get pointer POP B ; Get counter INR B ; Increment counter MOV A,B ; Check for new line ANI 3 CZ CRLF INX H ; Pt to next register JMPR RSHOW1 ; INCREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT RINC: INR M ; Increment it ; JMPR REGOUT ; Print result CALL REGOUT JMPR CRLFLOC ; DECREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT RDEC: DCR M ; Decrement value ; JMPR REGOUT ; Print result CALL REGOUT JMPR CRLFLOC ; SET REGISTER VALUE ; HL PTS TO REGISTER ON INPUT RSET: LXI D,FCB2+1 ; Pt to value MVI B,0 ; Init value to zero RSET1: LDAX D ; Get next digit INX D ; Pt to next SUI '0' ; Convert to binary JRC RSET2 CPI 10 ; Range? JRNC RSET2 MOV C,A ; Digit in c MOV A,B ; Multiply old by 10 ADD A ; *2 ADD A ; *4 ADD B ; *5 ADD A ; *10 ADD C ; Add in new digit MOV B,A ; Result in b JMPR RSET1 RSET2: MOV M,B ; Set value CALL REGOUT CRLFLOC: JMP CRLF REGOUT: ; Entry point with setting of error flag IF SETERR ; Set error flag MOV A,M ; Get register value STA Z3MSG+6 ; Copy into program error flag ENDIF REGOUT1: ; Entry point for not setting error flag CALL PRINT ; Print leading space DB ' '+80H MOV A,M ; Get register value MOV L,A ; Value in HL XRA A MOV H,A LXI D,100 ; Print 100's MVI B,80H ; Set flag to print leading space for zero CALL DECD ; Print 100's MVI E,10 ; Print 10's CALL DECD ; Print 10's MVI A,'0' ; Print 1's ADD L JMP CONOUT ; SET HL TO POINT TO MEMORY REGISTER WHOSE INDEX IS PTED TO BY HL ; ON INPUT, A CONTAINS REGISTER CHAR ; ON OUTPUT, HL = ADDRESS OF MEMORY REGISTER (REG 0 ASSUMED IF ERROR) REGPTR: MVI B,0 ; Init to zero SUI '0' ; Convert JRC REGP1 CPI 10 ; Range JRNC REGP1 MOV B,A ; Value in b REGP1: MOV A,B ; Value in a REGP2: LXI H,Z3MSG+30H ; Pt to memory registers ADD L ; Pt to proper register MOV L,A MOV A,H ACI 0 MOV H,A ; Hl pts to register RET ENDIF ; Regon ;Command: ECHO ;Function: Echo Text without Interpretation to Console or Printer ; ;Form: ; ECHO text <-- echo text to console ; ECHO $text <-- echo text to printer ; ; Additionally, if a form feed character is encountered in the ; output string, no further output will be done, a new line will be ; issued, and this will be followed by a form feed character. That is: ; ; ECHO $text^L ; ; will cause "text" to be printed on the printer followed by CR, LF, FF. IF ECHOON ECHO: CALL CRLF IF XECHO XRA A ; Lower case flag setting IF UPCASE ; If upper case default DCR A ENDIF STA CASEFL ; Store flag in code below ENDIF ; Xecho LXI H,TBUFF+1 ; Pt to first char CALL GETCHAR ; Get first character (should be blank) ; If none, exit from routine IF ECHOLST CALL GETCHAR ; Get first char after leading blank MOV B,A ; Save first char as list output flag CPI '$' ; Print flag? JRZ ECHO2 ; If so, go on DCX H ; Else backup one character ENDIF ; Echolst ; LOOP TO ECHO CHARS ECHO2: CALL GETCHAR IF ECHOLST CPI FF ; Form feed? JRZ ECHO3 ENDIF ; Echolst IF XECHO CPI '^' JRNZ ECHO2A ; Not control character prefix CALL GETCHAR ; Get next character ANI 1FH ; Convert to control character JMPR ECHO2D ; Echo it ECHO2A: CPI '%' ; Case shift prefix? JRNZ ECHO2D ; No, normal echo CALL GETCHAR ; Get next character CPI UCASECH ; Up-shift character? JRZ ECHO2C ; Store non-zero value in case flag ECHO2B: CPI LCASECH ; Lower-case character? JRNZ ECHO2D ; No, echo the character as is XRA A ; Else, clear case flag ECHO2C: STA CASEFL JMPR ECHO2 ; On to next character ENDIF ; Xecho ECHO2D: CALL ECHOUT ; Send char JMPR ECHO2 ; FORM FEED - SEND NEW LINE FOLLOWED BY FORM FEED IF PRINTER OUTPUT IF ECHOLST ECHO3: MOV A,B ; Check for printer output CPI '$' JRNZ ECHOFF ; Send form feed normally if not printer CALL ECHONL ; Send new line MVI A,FF ; Send form feed JMPR ECHOUT ; SEND FORM FEED CHAR TO CONSOLE ECHOFF: MVI A,FF ; Get char JMPR ECHO2D ENDIF ; Echolst ; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION ECHO4: IF NOT ECHOLST RET ELSE MOV A,B ; Get list mode flag CPI '$' RNZ ; Done if no printer output ; OUTPUT A NEW LINE ECHONL: MVI A,CR ; Output new line on printer CALL ECHOUT MVI A,LF ; Fall thru to echout ENDIF ; Not echolst ; OUTPUT CHAR TO PRINTER OR CONSOLE ECHOUT: MOV C,A ; Char in c IF XECHO CPI 'A' ; If less than 'a' JRC ECHOUTA ; Leave as is CPI 'Z'+1 ; If greater than 'z' JRNC ECHOUTA ; Leave as is ADI 20H ; Else convert to lower case ECHOUTA: MOV D,A ; Save lower case version in d CASEFL EQU $+1 ; Pointer for in-the-code modification MVI A,0 ORA A JRNZ ECHOUTB ; If upper case selected, go on as is MOV C,D ; Else substitute lower case version ECHOUTB: ENDIF ; Xecho PUSH H ; Save hl PUSH B ; Save bc LXI D,0CH-3 ; Offset for console output IF ECHOLST MOV A,B ; Check for printer output CPI '$' JRNZ ECHOUT1 INX D ; Add 3 for printer offset INX D INX D ENDIF ; Echolst ; OUTPUT CHAR IN C WITH BIOS OFFSET IN DE ECHOUT1: CALL BIOUT ; Bios output POP B ; Restore bc,hl POP H RET GETCHAR: MOV A,M ; Get character INX H ; Point to next one ORA A ; Check for end of string RNZ ; If not end, return POP H ; Else, clean up stack JR ECHO4 ; And exit from routine ; OUTPUT CHAR IN C TO BIOS WITH OFFSET IN DE BIOUT: LHLD WBOOT+1 ; Get address of warm boot DAD D ; Pt to routine PCHL ; Jump to it ENDIF ; Echoon ; ** SUPPORT UTILITIES ** ; CHECK FOR USER INPUT; IF ^C, RETURN WITH Z IF DIRON OR ERAON OR PROTON BREAK: PUSH H ; Save regs PUSH D PUSH B MVI C,11 ; Console status check CALL BDOS ORA A MVI C,1 ; Get char if any CNZ BDOS POP B ; Restore regs POP D POP H BREAK1: CPI CTRLC ; Check for abort JZ EXIT ; Exit CPI CTRLX ; Skip? RET ENDIF ; Diron or eraon or proton ; AFTER A SEARCH, RETURN NZ SET IF DESIRED TYPE OF FILE FOUND, Z IF NOT ; THIS ALGORITHM LOOKS AT THE SYSTEM BIT OF THE LOCATED FILE; THIS ; BIT IS SET TO 1 IF THE FILE IS A SYSTEM FILE AND 0 IF NOT A SYSTEM ; FILE. THE FOLLOWING EXCLUSIVE OR MASKS ARE APPLIED TO RETURN Z OR NZ ; AS REQUIRED BY THE CALLING PROGRAM: ; ; SYSTEM BYTE: X 0 0 0 0 0 0 0 (AFTER 80H MASK, X=1 IF SYS, 0 IF DIR) ; ; SYS-ONLY : 0 0 0 0 0 0 0 0 (XOR 0 = 0 if X=0, = 80H if X=1) ; DIR-ONLY : 1 0 0 0 0 0 0 0 (XOR 80H = 80h if X=0, = 0 if X=1) ; BOTH : 0 0 0 0 0 0 0 1 (XOR 1 = 81H or 1H, NZ in both cases) IF DIRON OR ERAON OR PROTON OR CPON OR RENON GETSBIT: DCR A ; Adjust to returned value RRC ; Convert number to offset into tbuff RRC RRC ANI 60H LXI D,TBUFF ; Pt to buffer ADD E ; Add entry offset to base addr MOV E,A ; Result in e PUSH D ; Save ptr in de ADI 10 ; Add offset of 10 to pt to system byte MOV E,A ; Set address LDAX D ; Get byte POP D ; Get ptr in de ANI 80H ; Look at only system bit SYSTST EQU $+1 ; In-the-code variable XRI 0 ; If systst=0, sys only; if systst=80h, dir ; Only; if systst=1, both sys and dir RET ; Nz if ok, z if not ok ; COPY HL TO DE FOR B BYTES BLKMOV: MOV A,M ; Get STAX D ; Put INX H ; Pt to next INX D DJNZ BLKMOV ; Loop RET ; PRINT FILE NOT FOUND MESSAGE PRFNF: CALL PRINT DB ' No File','s'+80H JMP EXIT ; LOG INTO USER AREA CONTAINED IN FCB1 LOGUSR: LDA FCB1+13 ; Get user number SETUSR: MOV E,A MVI C,32 ; Use bdos fct JMP BDOS ; PRINT FILE NAME PTED TO BY HL PRFN: CALL PRINT ; Leading space DB ' '+80H MVI B,8 ; 8 chars CALL PRFN1 MVI A,'.' ; Dot CALL CONOUT MVI B,3 ; 3 chars PRFN1: MOV A,M ; Get char INX H ; Pt to next CALL CONOUT ; Print char DJNZ PRFN1 ; Count down RET ; SEARCH FOR FIRST SEARF: PUSH B ; Save counter PUSH H ; Save hl MVI C,17 ; Search for first function SEARF1: LXI D,FCB1 ; Pt to fcb CALL BDOS INR A ; Set zero flag for error return POP H ; Get hl POP B ; Get counter RET ENDIF ; Diron or eraon or proton or cpon or renon ; SEARCH FOR NEXT IF DIRON OR ERAON OR PROTON SEARN: PUSH B ; Save counter PUSH H ; Save hl MVI C,18 ; Search for next function JMPR SEARF1 ; LOAD DIRECTORY AND SORT IT ; ON INPUT, A=SYSTST FLAG (0=SYS, 1=DIR, 80H=BOTH) ; DIRECTORY IS LOADED INTO DIRBUF ; RETURN WITH ZERO SET IF NO MATCH AND HL PTS TO 1ST ENTRY IF MATCH GETDIR: STA SYSTST ; Set system test flag CALL LOGUSR ; Log into user area of fcb1 LXI H,DIRBUF ; Pt to dir buffer MVI M,0 ; Set empty LXI B,0 ; Set counter CALL SEARF ; Look for match RZ ; Return if not found ; STEP 1: LOAD DIRECTORY GD1: PUSH B ; Save counter CALL GETSBIT ; Check for system ok POP B JRZ GD2 ; Not ok, so skip PUSH B ; Save counter INX D ; Pt to file name XCHG ; Hl pts to file name, de pts to buffer MVI B,11 ; Copy 11 bytes CALL BLKMOV ; Do copy XCHG ; Hl pts to next buffer location POP B ; Get counter INX B ; Increment counter GD2: CALL SEARN ; Look for next JRNZ GD1 MVI M,0 ; Store ending 0 LXI H,DIRBUF ; Pt to dir buffer MOV A,M ; Check for empty ORA A RZ ; STEP 2: SORT DIRECTORY PUSH H ; Save ptr to dirbuf for return CALL DIRALPHA ; Sort POP H XRA A ; Set nz flag for ok DCR A RET ; DIRALPHA -- ALPHABETIZES DIRECTORY IN DIRBUF; BC CONTAINS ; THE NUMBER OF FILES IN THE DIRECTORY DIRALPHA: ; SHELL SORT -- ; THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS" ; BY KERNIGAN AND PLAUGHER, PAGE 106. COPYRIGHT, 1976, ADDISON-WESLEY. MOV H,B ; Hl=bc=file count MOV L,C SHLD N ; Set "N" SHLD GAP ; Set initial gap to n for first division by 2 ; FOR (GAP = N/2; GAP > 0; GAP = GAP/2) SRTL0: ORA A ; Clear carry GAP EQU $+1 ; Pointer for in-the-code modification LXI H,0 ; Get previous gap MOV A,H ; Rotate right to divide by 2 RAR MOV H,A MOV A,L RAR MOV L,A ; TEST FOR ZERO ORA H RZ ; Done with sort if gap = 0 SHLD GAP ; Set value of gap SHLD II ; Set ii=gap for following loop ; FOR (II = GAP + 1; II <= N; II = II + 1) SRTL1: II EQU $+1 ; Pointer for in-the-code modification LXI H,0 ; Add 1 to ii INX H SHLD II ; TEST FOR II <= N XCHG ; Ii is in de N EQU $+1 ; Pointer for in-the-code modification LXI H,0 ; Number of items to sort MOV A,L ; Compare by subtraction SUB E MOV A,H SBB D ; Carry set means ii > n JRC SRTL0 ; Don't do for loop if ii > n XCHG ; Set jj = ii initially for first subtraction of gap SHLD JJ ; FOR (JJ = II - GAP; JJ > 0; JJ = JJ - GAP) SRTL2: LHLD GAP ; Get gap XCHG ; In de JJ EQU $+1 ; Pointer for in-the-code modification LXI H,0 ; Get jj MOV A,L ; Compute jj - gap SUB E MOV L,A MOV A,H SBB D MOV H,A SHLD JJ ; Jj = jj - gap JRC SRTL1 ; If carry from subtractions, jj < 0 and abort ORA L ; Jj=0? JRZ SRTL1 ; If zero, jj=0 and abort ; SET JG = JJ + GAP XCHG ; Jj in de LHLD GAP ; Get gap DAD D ; Jj + gap SHLD JG ; Jg = jj + gap ; IF (V(JJ) <= V(JG)) CALL ICOMPARE ; J in de, jg in hl ; ... THEN BREAK JRC SRTL1 ; ... ELSE EXCHANGE LHLD JJ ; Swap jj, jg XCHG JG EQU $+1 ; Pointer for in-the-code modification LXI H,0 CALL ISWAP ; Jj in de, jg in hl ; END OF INNER-MOST FOR LOOP JMPR SRTL2 ; SWAP (Exchange) the elements whose indexes are in HL and DE ISWAP: CALL IPOS ; Compute position from index XCHG CALL IPOS ; Compute 2nd element position from index MVI B,11 ; 11 bytes to flip ENDIF ; Diron or eraon or proton IF DIRON OR ERAON OR PROTON OR RENON ISWAP1: LDAX D ; Get bytes MOV C,M MOV M,A ; Put bytes MOV A,C STAX D INX H ; Pt to next INX D DJNZ ISWAP1 RET ENDIF ; Diron or eraon or proton or renon IF DIRON OR ERAON OR PROTON ; ICOMPARE compares the entry pointed to by the pointer pointed to by HL ; with that pointed to by DE (1st level indirect addressing); on entry, ; HL and DE contain the numbers of the elements to compare (1, 2, ...); ; on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)), ; and Non-Zero and No-Carry means ((DE)) > ((HL)) ICOMPARE: CALL IPOS ; Get position of first element XCHG CALL IPOS ; Get position of 2nd element XCHG ; COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE; ; NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE