CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / zsys / simtel20 / zcpr3 / sysrcp.asm < prev next >

Wrap

Assembly Source File | 1994-07-13 | 44.0 KB | 2,306 lines

* SYSTEM SEGMENT: SYS.RCP * SYSTEM: ARIES-1 * CUSTOMIZED BY: RICHARD CONN * * PROGRAM: SYSRCP.ASM * AUTHOR: RICHARD CONN * VERSION: 1.0 * DATE: 3 FEB 84 * PREVIOUS VERSIONS: NONE * VERSION EQU 10 * * SYSRCP is a resident command processor for ZCPR3. As with * all resident command processors, SYSRCP performs the following functions: * * 1. Assuming that the EXTFCB contains the name of the * command, SYSRCP looks to see if the first character * of the file name field in the EXTFCB is a question * mark; if so, it returns with the Zero Flag Set and * HL pointing to the internal routine which prints * its list of commands * 2. The resident command list in SYSRCP is scanned for * the entry contained in the file name field of * EXTFCB; if found, SYSRCP returns with the Zero Flag * Set and HL pointing to the internal routine which * implements the function; if not found, SYSRCP returns * with the Zero Flag Reset (NZ) * * * Global Library which Defines Addresses for SYSRCP * MACLIB Z3BASE ; USE BASE ADDRESSES MACLIB SYSRCP ; USE SYSRCP HEADER ; CTRLC EQU 'C'-'@' TAB EQU 09H LF EQU 0AH FF EQU 0CH CR EQU 0DH CTRLX EQU 'X'-'@' ; WBOOT EQU BASE+0000H ;CP/M WARM BOOT ADDRESS UDFLAG EQU BASE+0004H ;USER NUM IN HIGH NYBBLE, DISK IN LOW BDOS EQU BASE+0005H ;BDOS FUNCTION CALL ENTRY PT TFCB EQU BASE+005CH ;DEFAULT FCB BUFFER FCB1 EQU TFCB ;1st and 2nd FCBs FCB2 EQU TFCB+16 TBUFF EQU BASE+0080H ;DEFAULT DISK I/O BUFFER TPA EQU BASE+0100H ;BASE OF TPA DIRBUF EQU BASE+4000H ;DIR BUFFER (MANY ENTRIES PERMITTED) PAGCNT EQU DIRBUF-100H ;PAGE COUNT BUFFER OLDFCB EQU PAGCNT+1 ;OLD FCB BUFFER CPBLOCKS EQU 32 ;USE 4K FOR BUFFERING OF COPY ; $-MACRO ;FIRST TURN OFF THE EXPANSIONS ; ; MACROS TO PROVIDE Z80 EXTENSIONS ; MACROS INCLUDE: ; ; JR - JUMP RELATIVE ; JRC - JUMP RELATIVE IF CARRY ; JRNC - JUMP RELATIVE IF NO CARRY ; JRZ - JUMP RELATIVE IF ZERO ; JRNZ - JUMP RELATIVE IF NO ZERO ; DJNZ - DECREMENT B AND JUMP RELATIVE IF NO ZERO ; ; @GENDD MACRO USED FOR CHECKING AND GENERATING ; 8-BIT JUMP RELATIVE DISPLACEMENTS ; @GENDD MACRO ?DD ;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS IF (?DD GT 7FH) AND (?DD LT 0FF80H) DB 100H,?DD ;Displacement Range Error on Jump Relative ELSE DB ?DD ENDIF ;;RANGE ERROR ENDM ; ; ; Z80 MACRO EXTENSIONS ; JR MACRO ?N ;;JUMP RELATIVE IF I8080 ;;8080/8085 JMP ?N ELSE ;;Z80 DB 18H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM ; JRC MACRO ?N ;;JUMP RELATIVE ON CARRY IF I8080 ;;8080/8085 JC ?N ELSE ;;Z80 DB 38H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM ; JRNC MACRO ?N ;;JUMP RELATIVE ON NO CARRY IF I8080 ;;8080/8085 JNC ?N ELSE ;;Z80 DB 30H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM ; JRZ MACRO ?N ;;JUMP RELATIVE ON ZERO IF I8080 ;;8080/8085 JZ ?N ELSE ;;Z80 DB 28H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM ; JRNZ MACRO ?N ;;JUMP RELATIVE ON NO ZERO IF I8080 ;;8080/8085 JNZ ?N ELSE ;;Z80 DB 20H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM ; DJNZ MACRO ?N ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO IF I8080 ;;8080/8085 DCR B JNZ ?N ELSE ;;Z80 DB 10H @GENDD ?N-$-1 ENDIF ;;I8080 ENDM * * SYSTEM Entry Point * org rcp ; passed for Z3BASE db 'Z3RCP' ; Flag for Package Loader * * **** Command Table for RCP **** * This table is RCP-dependent! * * The command name table is structured as follows: * * ctable: * DB 'CMNDNAME' ; Table Record Structure is * DW cmndaddress ; 8 Chars for Name and 2 Bytes for Adr * ... * DB 0 ; End of Table * cnsize equ 4 ; NUMBER OF CHARS IN COMMAND NAME db cnsize ; size of text entries ctab: db 'H ' ; Help for RCP dw clist ctab1: ; IF CPON db 'CP ' ; Copy dw copy ENDIF ;CPON ; IF DIRON db 'DIR ' ; Directory dw dir ENDIF ;DIRON ; IF ECHOON db 'ECHO' ; Echo dw echo ENDIF ; IF ERAON db 'ERA ' ; Erase dw era ENDIF ;ERAON ; IF LTON AND LISTON db 'LIST' ; List dw list ENDIF ;LTON AND LISTON ; IF NOTEON db 'NOTE' ; Note-Comment-NOP Command dw note ENDIF ; IF PEEKON db 'P ' ; Peek into Memory dw peek ENDIF ;PEEKON ; IF POKEON db 'POKE' ; Poke Values into Memory dw poke ENDIF ;POKEON ; IF PROTON db 'PROT' ; Protection Codes dw att ENDIF ;PROTON ; IF REGON db 'REG ' ; Register Command dw regcmd ENDIF ;RSETON ; IF RENON db 'REN ' ; Rename dw ren ENDIF ;RENON ; IF LTON db 'TYPE' ; Type dw type ENDIF ;LTON ; IF WHLON db 'WHL ' ; Wheel dw whl db 'WHLQ' ; Wheel Query dw whlmsg ENDIF ;WHLON ; db 0 * * BANNER NAME OF RCP * rcp$name: db 'SYS ' db (version/10)+'0','.',(version mod 10)+'0' db RCPID db 0 * * Command List Routine * clist: lxi h,rcp$name ; print RCP Name call print1 lxi h,ctab1 ; print table entries mvi c,1 ; set count for 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: lxi d,entryname ; copy command name into message buffer mvi b,cnsize ; number of chars clist2: mov a,m ; copy stax d inx h ; pt to next inx d dcr b jnz clist2 inx h ; skip to next entry inx h push h ; save ptr lxi h,entrymsg ; print message call print1 pop h ; get ptr jmp 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 jmp print1 * * CLIST Messages * entrymsg: db ' ' ; command name prefix entryname: ds cnsize ; command name db 0 ; terminator * * **** RCP Routines **** * All code from here on is RCP-dependent! * ; ;Section 5A ;Command: DIR ;Function: To display a directory of the files on disk ;Forms: ; DIR <afn> Displays the DIR files ; DIR <afn> S Displays the SYS files ; DIR <afn> 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 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 CPI ' ' ;IF <SP>, ALL WILD CZ FILLQ LDA FCB2+1 ;GET FIRST CHAR OF 2ND FILE NAME MVI B,80H ;PREPARE FOR DIR-ONLY SELECTION CPI ' ' ;ANY FLAG? JRZ DIRPR ;THERE IS NO FLAG, SO DIR ONLY MVI B,1 ;SET FOR BOTH DIR AND SYS FILES CPI SYSFLG ;SYSTEM AND DIR FLAG SPECIFIER? JRZ DIRPR ;GOT SYSTEM SPECIFIER CPI SOFLG ;SYS ONLY? JRNZ DIRPR DCR B ;B=0 FOR SYS FILES ONLY ; ENDIF ;DIRON ; ; DIRECTORY PRINT ROUTINE; ON ENTRY, B REG IS SET AS FOLLOWS: ; 0 FOR ONLY SYSTEM FILES, 80H FOR ONLY DIR FILES, 1 FOR BOTH ; IF DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON 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 JZ EXIT ;EXIT IF DONE MOV A,E ;GET ENTRY COUNTER ORA A ;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE CZ DIRCRLF ;NEW LINE MOV A,E ;GET ENTRY COUNT 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 JR DIR3 ; ; CRLF FOR DIR ROUTINE ; DIRCRLF: PUSH PSW ;DON'T AFFECT PSW CALL CRLF ;NEW LINE POP PSW MVI E,4 ;RESET ENTRY COUNTER RET ; ; 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) ; GETSBIT: DCR A ;ADJUST TO RETURNED VALUE RRC ;CONVERT NUMBER TO OFFSET INTO TBUFF RRC RRC ANI 60H MOV C,A ;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY) LXI D,TBUFF ;PT TO BUFFER MOV A,E ;BASE ADDRESS IN A ADD C ;ADD IN ENTRY OFFSET 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 ; ; FILL FCB @HL WITH '?' ; FILLQ: MVI B,11 ;NUMBER OF CHARS IN FN & FT MVI A,'?' ;STORE '?' FILLP: MOV M,A ;STORE BYTE INX H ;PT TO NEXT DJNZ FILLP ;COUNT DOWN RET ; ; 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 LDIR ; 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: MOV A,B ; ANY FILES? ORA C RZ MOV H,B ; HL=BC=FILE COUNT MOV L,C SHLD N ; SET "N" ;* ;* SHELL SORT -- ;* THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS" ;* BY KERNIGAN AND PLAUGHER, PAGE 106. COPYRIGHT, 1976, ADDISON-WESLEY. ;* ON ENTRY, BC=NUMBER OF ENTRIES ;* N EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION LXI H,0 ; NUMBER OF ITEMS TO SORT 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 I ; SET I=GAP FOR FOLLOWING LOOP ;* FOR (I = GAP + 1; I <= N; I = I + 1) SRTL1: I EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION LXI H,0 ; ADD 1 TO I INX H SHLD I ;* TEST FOR I <= N XCHG ; I IS IN DE LHLD N ; GET N MOV A,L ; COMPARE BY SUBTRACTION SUB E MOV A,H SBB D ; CARRY SET MEANS I > N JRC SRTL0 ; DON'T DO FOR LOOP IF I > N LHLD I ; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP SHLD J ;* FOR (J = I - GAP; J > 0; J = J - GAP) SRTL2: LHLD GAP ; GET GAP XCHG ; ... IN DE J EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION LXI H,0 ; GET J MOV A,L ; COMPUTE J - GAP SUB E MOV L,A MOV A,H SBB D MOV H,A SHLD J ; J = J - GAP JRC SRTL1 ; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT MOV A,H ; J=0? ORA L JRZ SRTL1 ; IF ZERO, J=0 AND ABORT ;* SET JG = J + GAP XCHG ; J IN DE LHLD GAP ; GET GAP DAD D ; J + GAP SHLD JG ; JG = J + GAP ;* IF (V(J) <= V(JG)) CALL ICOMPARE ; J IN DE, JG IN HL ;* ... THEN BREAK JRC SRTL1 ;* ... ELSE EXCHANGE LHLD J ; SWAP J, JG XCHG JG EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION LXI H,0 CALL ISWAP ; J IN DE, JG IN HL ;* END OF INNER-MOST FOR LOOP JR 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 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 ;* ;* 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<HL ;* RET W/ZERO SET MEANS DE=HL ;* IF NOT SORTNT ; TYPE AND NAME? ;* ;* COMPARE BY FILE TYPE AND FILE NAME ;* PUSH H PUSH D LXI B,8 ; PT TO FT (8 BYTES) DAD B XCHG DAD B XCHG ; DE, HL NOW PT TO THEIR FT'S MVI B,3 ; 3 BYTES CALL COMP ; COMPARE FT'S POP D POP H RNZ ; CONTINUE IF COMPLETE MATCH MVI B,8 ; 8 BYTES JR COMP ; COMPARE FN'S ; ELSE ; NAME AND TYPE ;* ;* COMPARE BY FILE NAME AND FILE TYPE ;* MVI B,11 ; COMPARE FN, FT AND FALL THRU TO COMP ;* ;* COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL ;* MSB IS DISREGARDED ;* COMP: MOV A,M ; GET (HL) ANI 7FH ; MASK MSB MOV C,A ; ... IN C LDAX D ; COMPARE ANI 7FH ; MASK MSB CMP C RNZ INX H ; PT TO NEXT INX D DJNZ COMP ; COUNT DOWN RET ; ENDIF ; NOT SORTNT ;* ;* Compute physical position of element whose index is in HL; on exit, HL ;* is the physical address of this element; Indexes are 1..N ;* IPOS: DCX H ; HL=(HL-1)*11+DIRBUF MOV B,H ; BC=HL MOV C,L DAD H ; HL=HL*2 DAD H ; HL=HL*4 DAD B ; HL=HL*5 DAD H ; HL=HL*10 DAD B ; HL=HL*11 LXI B,DIRBUF ; ADD IN DIRBUF DAD B RET ; ENDIF ;DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON ; ;Section 5B ;Command: ERA ;Function: Erase files ;Forms: ; ERA <afn> Erase Specified files and print their names ; ERA <afn> 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 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: 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 LDIR 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? JZ EXIT CALL CRLF ;NEW LINE JR ERA1 ; ENDIF ;ERAON ; ;Section 5C ;Command: LIST ;Function: Print out specified file on the LST: Device ;Forms: ; LIST <afn> Print file (NO Paging) ;Notes: ; The flags which apply to TYPE do not take effect with LIST ; IF LTON LIST: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WLIST CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE MVI A,0FFH ;TURN ON PRINTER FLAG JR TYPE0 ; ;Section 5D ;Command: TYPE ;Function: Print out specified file on the CON: Device ;Forms: ; TYPE <afn> Print file ; TYPE <afn> P Print file with paging flag ;Notes: ; The flag PGDFLG defines the letter which toggles the paging ; facility (P in the forms section above) ; The flag PGDFLT determines if TYPE is to page by default ; (PGDFLT=TRUE if TYPE pages by default); combined with ; PGDFLG, the following events occur -- ; If PGDFLT = TRUE, PGDFLG turns OFF paging ; If PGDFLT = FALSE, PGDFLG turns ON paging ; TYPE: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WTYPE CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE XRA A ;TURN OFF PRINTER FLAG ; ; ENTRY POINT FOR CPR LIST FUNCTION (LIST) ; TYPE0: STA PRFLG ;SET FLAG LDA FCB2+1 ;GET PAGE FLAG STA PGFLG ;SAVE IT AS A FLAG MVI A,1 ;SELECT DIR FILES CALL GETDIR ;ALLOW AMBIGUOUS FILES JZ PRFNF ;NO FILES SHLD NXTFILE ;SET PTR TO NEXT FILE JR TYPEX2 TYPEX: LHLD NXTFILE ;GET PTR TO NEXT FILE MOV A,M ;ANY FILES? ORA A JZ EXIT LDA PRFLG ;CHECK FOR LIST OUTPUT ORA A ;0=TYPE JRZ TYPEX1 MVI A,CR ;BOL ON PRINTER CALL LCOUT MVI A,FF ;FORM FEED THE PRINTER CALL LCOUT JR TYPEX2 TYPEX1: CALL PAGEBREAK ;PAGE BREAK MESSAGE TYPEX2: LXI D,FCB1+1 ;COPY INTO FCB1 MVI B,11 ;11 BYTES CALL LDIR SHLD NXTFILE ;SET PTR TO NEXT FILE CALL INITFCB1 ;INIT FCB1 MVI C,15 ;OPEN FILE CALL BDOS INR A ;SET ERROR FLAG JZ PRFNF ;ABORT IF ERROR MVI A,NLINES-2 ;SET LINE COUNT STA PAGCNT MVI A,CR ;NEW LINE CALL LCOUT MVI A,LF CALL LCOUT LXI B,080H ;SET CHAR POSITION AND TAB COUNT ; (B=0=TAB, C=080H=CHAR POSITION) ; ; MAIN LOOP FOR LOADING NEXT BLOCK ; TYPE2: MOV A,C ;GET CHAR COUNT CPI 80H JRC TYPE3 PUSH H ;READ NEXT BLOCK PUSH B LXI D,FCB1 ;PT TO FCB MVI C,20 ;READ RECORD CALL BDOS ORA A ;SET FLAGS POP B POP H JRNZ TYPE7 ;END OF FILE? MVI C,0 ;SET CHAR COUNT LXI H,TBUFF ;PT TO FIRST CHAR ; ; MAIN LOOP FOR PRINTING CHARS IN TBUFF ; TYPE3: MOV A,M ;GET NEXT CHAR ANI 7FH ;MASK OUT MSB CPI 1AH ;END OF FILE (^Z)? JRZ TYPE7 ;NEXT FILE IF SO ; ; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION ; CPI CR ;RESET TAB COUNT? JRZ TYPE4 CPI LF ;RESET TAB COUNT? JRZ TYPE4 CPI TAB ;TAB? JRZ TYPE5 ; ; OUTPUT CHAR AND INCREMENT CHAR COUNT ; CALL LCOUT ;OUTPUT CHAR JZ TYPEX ;SKIP INR B ;INCREMENT TAB COUNT JR TYPE6 ; ; OUTPUT <CR> OR <LF> AND RESET TAB COUNT ; TYPE4: CALL LCOUT ;OUTPUT <CR> OR <LF> JZ TYPEX ;SKIP MVI B,0 ;RESET TAB COUNTER JR TYPE6 ; ; TABULATE ; TYPE5: MVI A,' ' ;<SP> CALL LCOUT JZ TYPEX ;SKIP INR B ;INCR POS COUNT MOV A,B ANI 7 JRNZ TYPE5 ; ; CONTINUE PROCESSING ; TYPE6: INR C ;INCREMENT CHAR COUNT INX H ;PT TO NEXT CHAR CALL BREAK ;CHECK FOR ABORT JZ TYPEX ;SKIP JR TYPE2 TYPE7: LXI D,FCB1 ;CLOSE FILE MVI C,16 ;BDOS FUNCTION CALL BDOS JMP TYPEX ; ; SEND OUTPUT TO LST: OR CON:, AS PER THE FLAG ; RETURN WITH Z IF ABORT ; LCOUT: PUSH H ;SAVE REGS PUSH D PUSH B MOV E,A ;CHAR IN E MVI C,2 ;OUTPUT TO CON: PRFLG EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION MVI A,0 ;2ND BYTE IS THE PRINT FLAG ORA A ;0=TYPE JRZ LC1 MVI C,5 ;OUTPUT TO LST: LC1: PUSH D ;SAVE CHAR CALL BDOS ;OUTPUT CHAR IN E POP D ;GET CHAR MOV A,E CPI LF JRNZ LC2 LDA PRFLG ;OUTPUT TO LST:? ORA A ;NZ = YES JRNZ LC2 ; ; CHECK FOR PAGING ; LXI H,PAGCNT ;COUNT DOWN DCR M JRNZ LC2 ;JUMP IF NOT END OF PAUSE MVI M,NLINES-2 ;REFILL COUNTER PGFLG EQU $+1 ;POINTER TO IN-THE-CODE BUFFER MVI A,0 ;2ND BYTE IS THE PAGING FLAG CPI PGDFLG ;PAGE DEFAULT OVERRIDE OPTION WANTED? ; IF PGDFLT ;IF PAGING IS DEFAULT ; JRZ LC2 ;PGDFLG MEANS NO PAGING ; ELSE ; JRNZ LC2 ;PGDFLG MEANS PAGE ; ENDIF ;PGDFLT ; CALL PAGEBREAK ;PRINT PAGE BREAK MESSAGE JR LC3 ;Z TO SKIP LC2: XRA A ;SET OK DCR A ;NZ=OK LC3: POP B ;RESTORE REGS POP D POP H RET ; ; PRINT PAGE BREAK MESSAGE AND GET USER INPUT ; ABORT IF ^C, RZ IF ^X ; PAGEBREAK: PUSH H ;SAVE HL CALL PRINT DB cr,lf,' Typing',' '+80H LXI H,FCB1+1 ;PRINT FILE NAME CALL PRFN CALL DASH ;PRINT DASH CALL CONIN ;GET INPUT POP H ;RESTORE HL PUSH PSW CALL CRLF ;NEW LINE POP PSW CPI CTRLC ;^C JZ EXIT CPI CTRLX ;SKIP? RET ; ENDIF ;LTON ; ;Section 5E ;Command: REN ;Function: To change the name of an existing file ;Forms: ; REN <New ufn>=<Old ufn> Perform function ; IF RENON REN: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WREN CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE ; ; ; STEP 1: CHECK FOR FILE 2 BEING AMBIGUOUS ; LXI H,FCB2+1 ;CAN'T BE AMBIGUOUS CALL AMBCHK1 ; ; STEP 2: LOG INTO USER AREA ; CALL LOGUSR ;LOG INTO USER AREA OF FCB1 ; ; STEP 3: SEE IF NEW FILE ALREADY EXISTS ; EXTEST PERFORMS A NUMBER OF CHECKS: ; 1) AMBIGUITY ; 2) R/O ; 3) IF FILE EXISTS AND NOT R/O, PERMISSION TO DELETE ; CALL EXTEST JZ EXIT ;R/O OR NO PERMISSION ; ; STEP 4: EXCHANGE FILE NAME FIELDS FOR RENAME ; LXI H,FCB1 ;EXCHANGE NAMES ONLY PUSH H ;SAVE PTR INX H LXI D,FCB2+1 MVI B,11 ;11 BYTES REN1: LDAX D ;GET OLD MOV C,A MOV A,M STAX D ;PUT NEW MOV M,C INX H ;PT TO NEXT INX D DJNZ REN1 ; ; STEP 5: SEE IF OLD FILE IS R/O ; CALL SEARF ;LOOK FOR FILE JZ PRFNF CALL GETSBIT ;GET PTR TO ENTRY IN TBUFF XCHG ;HL PTS TO ENTRY INX H ;PT TO FN CALL ROTEST ;SEE IF FILE IS R/O JNZ EXIT ; ; STEP 6: RENAME THE FILE ; POP D ;GET PTR TO FCB MVI C,23 ;RENAME CALL BDOS INR A ;SET ZERO FLAG IF ERROR JZ PRFNF ;PRINT NO SOURCE FILE MESSAGE JMP EXIT ; ENDIF ;RENON ; ;Section 5F ;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 CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE 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 JR ATT3 ATTI: STA INSPECT ;SET FLAG JR ATT2 ATTR: MVI H,80H ;SET R/O BIT JR ATT2 ATTS: MVI L,80H ;SET SYS BIT JR ATT2 ATT3: SHLD FATT ;SAVE FILE ATTRIBUTES MVI A,1 ;SELECT DIR AND SYS FILES CALL GETDIR ;LOAD DIRECTORY JZ PRFNF ;NO FILE ERROR SHLD NXTFILE ;PT TO NEXT FILE JR ATT5 ATT4: LHLD NXTFILE ;PT TO NEXT FILE MOV A,M ;END OF LIST? ORA A JZ EXIT CALL CRLF ;NEW LINE ATT5: 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 LDIR 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 JR 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 ; ;Section 5G ;Command: CP ;Function: To copy a file from one place to another ; ;Form: ; CP new=old ; IF CPON COPY: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WCP 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 LDIR ; ; STEP 1: SEE IF NEW=OLD AND ABORT IF SO ; COPY0: LXI H,FCB1 ;PT TO NEXT 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: LDAX D ;GET OLD CMP M ;COMPARE TO NEW JRNZ COPY2 INX H ;PT TO NEXT INX D DJNZ COPY1 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 JR 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: SEE IF OLD FILE EXISTS ; LXI H,OLDFCB ;COPY OLD INTO 2ND FCB PUSH H ;SAVE PTR TO 2ND FCB XCHG MVI B,14 ;14 BYTES CALL LDIR CALL LOGOLD ;LOG IN USER NUMBER OF OLD FCB POP H ;GET PTR TO 2ND FCB CALL INITFCB2 ;INIT FCB MVI C,17 ;LOOK FOR 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 COPY4 ; ; COPY ERROR ; CPERR: CALL PRINT DB ' Copy','?'+80H JMP EXIT ; ; STEP 6: OPEN OLD ; COPY4: CALL LOGOLD ;GET USER LXI H,OLDFCB ;PT TO FCB CALL INITFCB2 ;INIT FCB MVI C,15 ;OPEN FILE CALL BDOS ; ; STEP 7: COPY OLD TO NEW WITH BUFFERING ; COPY5: CALL LOGOLD ;GET USER MVI B,0 ;SET COUNTER LXI H,TPA ;SET NEXT ADDRESS TO COPY INTO 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 LDIR XCHG ;HL PTS TO NEXT POP B ;GET COUNTER INR B ;INCREMENT IT MOV A,B ;DONE? CPI CPBLOCKS ;DONE IF CPBLOCKS 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,TPA ;PT TO TPA COPY5C: LXI D,TBUFF ;COPY INTO TBUFF MVI B,128 ;128 BYTES CALL LDIR 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 JR COPY5C ; ; STEP 8: CLOSE FILES ; COPY6: CALL LOGOLD ;GET USER LXI D,OLDFCB ;PT TO FCB MVI C,16 ;CLOSE FILE CALL BDOS CALL LOGNEW ;GET USER LXI D,FCB1 ;PT TO FCB MVI C,16 ;CLOSE FILE CALL BDOS CALL PRINT DB ' Don','e'+80H JMP EXIT ; ; 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 ; ;Section 5H ;Command: PEEK ;Function: Display memory ; ;Form: ; PEEK startadr - 256 bytes displayed ; PEEK startadr endadr - range of bytes displayed ; IF PEEKON PEEK: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WPEEK CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE LXI H,TBUFF+1 ;FIND FIRST NUMBER NXTPEEK EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION LXI D,0 ;DEFAULT PEEK ADDRESS IF NONE CALL SKSP ;SKIP TO NON-BLANK CNZ HEXNUM ;GET START ADDRESS IF ANY (ELSE DEFAULT) CALL PRINT DB ' Pee','k'+80H CALL ADRAT ;PRINT ADDRESS MESSAGE PUSH D ;SAVE IT LXI B,256 ;COMPUTE END ADDRESS XCHG DAD B XCHG ;END ADDRESS IN DE CALL SKSP ;SKIP TO NON-BLANK JRZ PEEK1 ;PROCESS CALL HEXNUM ;GET 2ND NUMBER IN DE PEEK1: POP H ;HL IS START ADDRESS, DE IS END ADDRESS CALL PEEK2 ;DO PEEK SHLD NXTPEEK ;SET CONTINUED PEEK ADDRESS JMP EXIT ; ; DISPLAY LOOP ; PEEK2: MOV A,D ;SEE IF DE<=HL CMP H RC ;OUT OF BOUNDS JRNZ PEEK2A ;HL > DE MOV A,E CMP L RZ RC PEEK2A: CALL CRLF ;NEW LINE MOV A,H ;PRINT ADDRESS CALL PASHC MOV A,L CALL PAHC CALL DASH ;PRINT LEADER MVI B,16 ;16 BYTES TO DISPLAY PUSH H ;SAVE START ADDRESS PEEK3: MOV A,M ;GET NEXT BYTE CALL PASHC ;PRINT WITH LEADING SPACE INX H ;PT TO NEXT DJNZ PEEK3 POP H ;PT TO FIRST MVI B,16 ;16 BYTES MVI A,' ' ;SPACE AND FENCE CALL CONOUT CALL PRINT DB FENCE+80H PEEK4: MOV A,M ;GET NEXT BYTE MVI C,'.' ;ASSUME DOT ANI 7FH ;MASK IT CPI ' ' ;DOT IF LESS THAN SPACE JRC PEEK5 CPI 7FH ;DON'T PRINT DEL JRZ PEEK5 MOV C,A ;CHAR IN C PEEK5: MOV A,C ;GET CHAR CALL CONOUT ;SEND IT INX H ;PT TO NEXT DJNZ PEEK4 CALL PRINT ;CLOSING FENCE DB FENCE+80H CALL BREAK ;ALLOW ABORT JR PEEK2 ; ENDIF ;PEEKON ; ; PRINT A AS 2 HEX CHARS ; PASHC - LEADING SPACE ; IF PEEKON OR POKEON 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 ; ENDIF ;PEEKON OR POKEON ; ;Section 5I ;Command: POKE ;Function: Place Values into Memory ; ;Form: ; POKE startadr val1 val2 ... ; IF POKEON POKE: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; IF WPOKE CALL WHLTST ENDIF ;WHEEL APPROVAL ; CALL RETSAVE LXI H,TBUFF+1 ;PT TO FIRST CHAR CALL SKSP ;SKIP TO NON-BLANK JRZ NOARGS ;ARG ERROR CALL HEXNUM ;CONVERT TO NUMBER CALL PRINT DB ' Pok','e'+80H CALL ADRAT ;PRINT AT MESSAGE ; ; LOOP FOR STORING HEX VALUES SEQUENTIALLY VIA POKE ; POKE1: PUSH D ;SAVE ADDRESS CALL SKSP ;SKIP TO NON-BLANK JZ EXIT ;DONE CPI '"' ;QUOTED TEXT? JRZ POKE2 CALL HEXNUM ;GET NUMBER MOV A,E ;GET LOW POP D ;GET ADDRESS STAX D ;STORE NUMBER INX D ;PT TO NEXT JR POKE1 ; ; STORE ASCII CHARS ; POKE2: POP D ;GET NEXT ADDRESS INX H ;PT TO NEXT CHAR POKE3: MOV A,M ;GET NEXT CHAR ORA A ;DONE? JZ EXIT STAX D ;PUT CHAR INX H ;PT TO NEXT INX D JR POKE3 ; ; No Argument Error ; NOARGS: CALL PRINT DB ' Arg','?'+80H JMP EXIT ; ENDIF ;POKEON ; ;Section 5J ;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 REGCMD: LXI H,FCB1+1 ;PT TO FIRST ARG MOV A,M ;GET FIRST CHAR PUSH PSW ;SAVE CHAR CPI 'A' ;ASSUME DIGIT IF LESS THAN 'A' JRC REGC1 INX H ;PT TO DIGIT REGC1: MOV A,M ;GET DIGIT CALL REGPTR ;PT TO REGISTER POP PSW ;GET CHAR 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 CALL REGOUT ;PRINT REGISTER VALUE 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 JR RSHOW1 ; ; INCREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT ; RINC: INR M ;INCREMENT IT JR REGOUT ;PRINT RESULT ; ; DECREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT ; RDEC: DCR M ;DECREMENT VALUE JR REGOUT ;PRINT RESULT ; ; 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 JR RSET1 RSET2: MOV M,B ;SET VALUE REGOUT: CALL PRINT ;PRINT LEADING SPACE DB ' '+80H MOV A,M ;GET REGISTER VALUE MVI B,100 ;PRINT 100'S MVI C,0 ;SET LEADING SPACE FLAG CALL DECB ;PRINT 100'S MVI B,10 ;PRINT 10'S CALL DECB ;PRINT 10'S ADI '0' ;PRINT 1'S JMP CONOUT ; ; SUBTRACT B FROM A UNTIL CARRY, THEN PRINT DIGIT COUNT ; DECB: MVI D,'0' ;SET DIGIT DECB1: SUB B ;SUBTRACT JRC DECB2 INR D ;ADD 1 TO DIGIT CHAR JR DECB1 DECB2: ADD B ;ADD BACK IN MOV E,A ;SAVE A IN E MOV A,D ;GET DIGIT CHAR CPI '0' ;LEADING ZERO CHECK JRNZ DECB3 MOV A,C ;ANY LEADING DIGIT YET? ORA A JRZ DECB4 DECB3: MOV A,D ;GET DIGIT CHAR CALL CONOUT ;PRINT IT INR C ;SET C<>0 FOR LEADING DIGIT CHECK DECB4: MOV A,E ;RESTORE A FOR NEXT ROUND RET ; ; 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 ; ;Section 5K ;Command: WHL/WHLQ ;Function: Set the Wheel Byte on or off ; ;Form: ; WHL -- turn Wheel Byte OFF ; WHL password -- turn Wheel Byte ON if password is correct ; WHLQ -- find out status of Wheel Byte ; IF WHLON WHL: LXI H,FCB1+1 ;PT TO FIRST CHAR MOV A,M ;GET IT CPI ' ' ;TURN BYTE OFF IF NO PASSWORD JRZ WHLOFF LXI D,WHLPASS MVI B,8 ;CHECK 8 CHARS WHL1: LDAX D ;GET CHAR CMP M ;COMPARE JRNZ WHLMSG INX H ;PT TO NEXT INX D DJNZ WHL1 ; ; TURN ON WHEEL BYTE ; MVI A,0FFH ;TURN ON WHEEL BYTE JR WHLSET ; ; TURN OFF WHEEL BYTE ; WHLOFF: XRA A ;TURN OFF WHEEL BYTE WHLSET: STA Z3WHL ;SET WHEEL BYTE AND PRINT MESSAGE ; ; PRINT WHEEL BYTE MESSAGE ; WHLMSG: CALL PRINT DB ' Wheel Byte',' '+80H LDA Z3WHL ;GET WHEEL BYTE ORA A ;ZERO IS OFF JRZ OFFM CALL PRINT DB 'O','N'+80H RET OFFM: CALL PRINT DB 'OF','F'+80H RET ; ; WHEEL PASSWORD DEFINED FROM SYSRCP.LIB FILE ; DB 'Z'-'@' ;LEADING ^Z IN CASE OF TYPE WHLPASS: WPASS ;USE MACRO ; ENDIF ;WHLON ; ;Section 5L ;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. ; ECHO: LXI H,TBUFF+1 ;PT TO FIRST CHAR ECHO1: MOV A,M ;SKIP LEADING SPACES INX H ;PT TO NEXT CPI ' ' JRZ ECHO1 ; IF ECHOLST MOV B,A ;CHAR IN B CPI '$' ;PRINT FLAG? JRZ ECHO2 ENDIF ;ECHOLST ; DCX H ;PT TO CHAR ; ; LOOP TO ECHO CHARS ; ECHO2: MOV A,M ;GET CHAR ORA A ;EOL? JRZ ECHO4 ; IF ECHOLST CPI FF ;FORM FEED? JRZ ECHO3 ENDIF ;ECHOLST ; ECHO2C: CALL ECHOUT ;SEND CHAR INX H ;PT TO NEXT JR 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 JR ECHOUT ; ; SEND FORM FEED CHAR TO CONSOLE ; ECHOFF: MVI A,FF ;GET CHAR JR ECHO2C ENDIF ;ECHOLST ; ; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION ; ECHO4: IF NOT ECHOLST ; RET ; ELSE ; MOV A,B ;CHECK FOR PRINTER OUTPUT 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 PUSH H ;SAVE HL PUSH B ;SAVE BC LXI D,0CH-3 ;OFFSET FOR CONSOLE OUTPUT ; IF ECHOLST MOV A,B ;CHECK FOR PRINTER 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 ; ; 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 ; ; ** SUPPORT UTILITIES ** ; ; ; CHECK FOR USER INPUT; IF ^C, RETURN WITH Z ; BREAK: PUSH H ;SAVE REGS PUSH D PUSH B MVI E,0FFH ;GET CHAR IF ANY MVI C,6 ;CONSOLE STATUS CHECK CALL BDOS POP B ;RESTORE REGS POP D POP H CPI CTRLC ;CHECK FOR ABORT JZ EXIT ;EXIT CPI CTRLX ;SKIP? RET ; ; COPY HL TO DE FOR B BYTES ; LDIR: MOV A,M ;GET STAX D ;PUT INX H ;PT TO NEXT INX D DJNZ LDIR ;LOOP RET ; ; PRINT FILE NOT FOUND MESSAGE ; PRFNF: CALL PRINT DB ' No File','s'+80H JMP EXIT ; ; OUTPUT NEW LINE TO CON: ; CRLF: MVI A,CR CALL CONOUT MVI A,LF JMP CONOUT ; ; SEARCH FOR FIRST AND NEXT ; 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 SEARN: PUSH B ; SAVE COUNTER PUSH H ; SAVE HL MVI C,18 ; SEARCH FOR NEXT FUNCTION JR SEARF1 ; ; CONSOLE INPUT ; CONIN: PUSH H ; SAVE REGS PUSH D PUSH B MVI C,1 ; INPUT CALL BDOS POP B ; GET REGS POP D POP H ANI 7FH ; MASK MSB CPI 61H RC ANI 5FH ; TO UPPER CASE RET ; ; 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 ; ; SAVE RETURN ADDRESS ; RETSAVE: POP D ; GET RETURN ADDRESS POP H ; GET RETURN ADDRESS TO ZCPR3 SHLD Z3RET ; SAVE IT PUSH H ; PUT RETURN ADDRESS TO ZCPR3 BACK PUSH D ; PUT RETURN ADDRESS BACK RET ; ; EXIT TO ZCPR3 ; EXIT: Z3RET EQU $+1 ; POINTER TO IN-THE-CODE MODIFICATION LXI H,0 ; RETURN ADDRESS PCHL ; GOTO ZCPR3 ; ; TEST WHEEL BYTE FOR APPROVAL ; IF WHEEL BYTE IS 0 (OFF), ABORT WITH A MESSAGE (FLUSH RET ADR AND EXIT) ; IF WHEEL ;IF ANY WHEEL OPTION IS RUNNING WHLTST: LDA Z3WHL ;GET WHEEL BYTE ORA A ;ZERO? RNZ POP PSW ;CLEAR STACK CALL PRINT DB ' No Whee','l'+80H RET ENDIF ;WHEEL ; ; PRINT A DASH ; IF LTON OR PEEKON DASH: CALL PRINT DB ' -',' '+80H RET ; ENDIF ;LTON OR PEEKON ; ; PRINT ADDRESS MESSAGE ; PRINT ADDRESS IN DE ; IF PEEKON OR POKEON ADRAT: CALL PRINT DB ' at',' '+80H MOV A,D ;PRINT HIGH CALL PAHC MOV A,E ;PRINT LOW JMP PAHC ; ; EXTRACT HEXADECIMAL NUMBER FROM LINE PTED TO BY HL ; RETURN WITH VALUE IN DE AND HL PTING TO OFFENDING CHAR ; HEXNUM: LXI D,0 ;DE=ACCUMULATED VALUE MVI B,5 ;B=CHAR COUNT HNUM1: MOV A,M ;GET CHAR CPI ' '+1 ;DONE? RC ;RETURN IF SPACE OR LESS INX H ;PT TO NEXT SUI '0' ;CONVERT TO BINARY JRC NUMERR ;RETURN AND DONE IF ERROR CPI 10 ;0-9? JRC HNUM2 SUI 7 ;A-F? CPI 10H ;ERROR? JRNC NUMERR HNUM2: MOV C,A ;DIGIT IN C MOV A,D ;GET ACCUMULATED VALUE RLC ;EXCHANGE NYBBLES RLC RLC RLC ANI 0F0H ;MASK OUT LOW NYBBLE MOV D,A MOV A,E ;SWITCH LOW-ORDER NYBBLES RLC RLC RLC RLC MOV E,A ;HIGH NYBBLE OF E=NEW HIGH OF E, ; LOW NYBBLE OF E=NEW LOW OF D ANI 0FH ;GET NEW LOW OF D ORA D ;MASK IN HIGH OF D MOV D,A ;NEW HIGH BYTE IN D MOV A,E ANI 0F0H ;MASK OUT LOW OF E ORA C ;MASK IN NEW LOW MOV E,A ;NEW LOW BYTE IN E DJNZ HNUM1 ;COUNT DOWN RET ; ; NUMBER ERROR ; NUMERR: CALL PRINT DB ' Num','?'+80H JMP EXIT ; ; SKIP TO NEXT NON-BLANK ; SKSP: MOV A,M ;GET CHAR INX H ;PT TO NEXT CPI ' ' ;SKIP SPACES JRZ SKSP DCX H ;PT TO GOOD CHAR ORA A ;SET EOL FLAG RET ; ENDIF ;PEEKON OR POKEON ; ; Test File in FCB for unambiguity and existence, ask user to delete if so ; Return with Z flag set if R/O or no permission to delete ; IF RENON OR CPON EXTEST: CALL AMBCHK ;AMBIGUOUS FILE NAMES NOT ALLOWED CALL SEARF ;LOOK FOR SPECIFIED FILE JRZ EXOK ;OK IF NOT FOUND CALL GETSBIT ;POSITION INTO DIR INX D ;PT TO FILE NAME XCHG ;HL PTS TO FILE NAME PUSH H ;SAVE PTR TO FILE NAME CALL PRFN ;PRINT FILE NAME POP H CALL ROTEST ;CHECK FOR R/O JRNZ EXER CALL ERAQ ;ERASE? JRNZ EXER ;RESTART AS ERROR IF NO LXI D,FCB1 ;PT TO FCB1 MVI C,19 ;DELETE FILE CALL BDOS EXOK: XRA A DCR A ;NZ = OK RET EXER: XRA A ;ERROR FLAG - FILE IS R/O OR NO PERMISSION RET ; ; CHECK FOR AMBIGUOUS FILE NAME IN FCB1 ; RETURN Z IF SO ; AMBCHK: LXI H,FCB1+1 ;PT TO FCB ; ; CHECK FOR AMBIGUOUS FILE NAME PTED TO BY HL ; AMBCHK1: PUSH H MVI B,11 ;11 BYTES AMB1: MOV A,M ;GET CHAR ANI 7FH ;MASK CPI '?' JRZ AMB2 INX H ;PT TO NEXT DJNZ AMB1 DCR B ;SET NZ FLAG POP D RET AMB2: POP H ;PT TO FILE NAME CALL PRFN CALL PRINT DB ' is AF','N'+80H JMP EXIT ; ENDIF ;RENON OR CPON ; ; CHECK USER TO SEE IF HE APPROVES ERASE OF FILE ; RETURN WITH Z IF YES ; IF RENON OR CPON OR ERAON OR PROTON ERAQ: CALL PRINT DB ' - Eras','e'+80H ERAQ1: CALL PRINT DB ' (Y/N)?',' '+80H CALL CONIN ;GET RESPONSE CPI 'Y' ;KEY ON YES RET ; ENDIF ;RENON OR CPON OR ERAON OR PROTON ; ; TEST FILE PTED TO BY HL FOR R/O ; NZ IF R/O ; IF RENON OR ERAON OR CPON ROTEST: PUSH H ;ADVANCE TO R/O BYTE LXI B,8 ;PT TO 9TH BYTE DAD B MOV A,M ;GET IT ANI 80H ;MASK BIT PUSH PSW LXI H,ROMSG CNZ PRINT1 ;PRINT IF NZ POP PSW ;GET FLAG POP H ;GET PTR RET ROMSG: DB ' is R/','O'+80H ; ENDIF ;RENON OR ERAON OR CPON ; ; INIT FCB1, RETURN WITH DE PTING TO FCB1 ; IF ERAON OR LTON OR CPON INITFCB1: LXI H,FCB1 ;PT TO FCB INITFCB2: PUSH H ;SAVE PTR LXI B,12 ;PT TO FIRST BYTE DAD B MVI B,24 ;ZERO 24 BYTES XRA A ;ZERO FILL CALL FILLP ;FILL MEMORY POP D ;PT TO FCB RET ; ENDIF ;ERAON OR LTON OR CPON ; ; BUFFERS ; NXTFILE: DS 2 ;PTR TO NEXT FILE IN LIST ; ; SIZE ERROR TEST ; IF ($ GT (RCP + RCPS*128)) SIZERR EQU NOVALUE ;RCP IS TOO LARGE FOR BUFFER ENDIF ; ; END OF SYS.RCP ; END