CP/M

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

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

Wrap

Assembly Source File | 1994-07-13 | 17.1 KB | 945 lines

* SYSTEM SEGMENT: SYS.FCP * SYSTEM: ZCPR3 * CUSTOMIZED BY: RICHARD CONN * * PROGRAM: SYSFCP.ASM * AUTHOR: RICHARD CONN * VERSION: 1.0 * DATE: 22 FEB 84 * PREVIOUS VERSIONS: NONE * VERSION EQU 10 * * Global Library which Defines Addresses for SYSTEM * MACLIB Z3BASE ; USE BASE ADDRESSES MACLIB SYSFCP ; USE EQUATES FROM HEADER FILE ; LF EQU 0AH CR EQU 0DH BELL EQU 07H ; BASE EQU 0 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 ; $-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 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 fcp ; passed for Z3BASE db 'Z3FCP' ; Flag for Package Loader * * **** Command Table for FCP **** * This table is FCP-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 'IF ' dw ifstart db 'ELSE' dw ifelse db 'FI ' dw ifend db 'XIF ' dw ifexit db 0 ; ; Condition Table ; condtab: ; IF IFOTRUE db 'T ' ;TRUE dw ifctrue db 'F ' ;FALSE dw ifcfalse ENDIF ; IF IFOEMPTY db 'EM' ;file empty dw ifcempty ENDIF ; IF IFOERROR db 'ER' ;error message dw ifcerror ENDIF ; IF IFOEXIST db 'EX' ;file exists dw ifcex ENDIF ; IF IFOINPUT db 'IN' ;user input dw ifcinput ENDIF ; IF IFONULL db 'NU' dw ifcnull ENDIF ; IF IFOTCAP ;Z3 TCAP available db 'TC' dw ifctcap ENDIF ; IF IFOWHEEL ;Wheel Byte db 'WH' dw ifcwheel ENDIF ; db 0 * * Print " IF" * prif: call print db 'IF',' '+80H ret * * Print String (terminated in 0 or MSB Set) at Return Address * print: IF NOISE mvi a,' ' ;print leading space call conout ENDIF ;NOISE xthl ; get address call print1 xthl ; put address ret * * Print String (terminated by MSB Set) pted to by HL * print1: mov a,m ; done? inx h ; pt to next call conout ; print char ora a ; set MSB flag (M) rm ; MSB terminator jr print1 * * **** FCP Routines **** * All code from here on is FCP-dependent! * ; ; FCP Command: XIF ; XIF terminates all IFs, restoring a basic TRUE state ; ifexit: IF NOISE call nl ;print new line ENDIF ;NOISE call iftest ;see if current IF is running and FALSE jrz ifstat ;abort with status message if so lxi h,z3msg+1 ;pt to IF flag xra a ;A=0 mov m,a ;zero IF flag jr ifendmsg ;print message ; ; FCP Command: FI ; FI decrements to the previous IF ; ; Algorithm: ; Rotate Current IF Bit (1st IF Message) Right 1 Bit Position ; ifend: IF NOISE call nl ;print new line ENDIF ;NOISE lxi h,z3msg+1 ;pt to IF flag mov a,m ;get it ora a ;no IF active? jrz ifnderr ifendmsg: IF NOISE push psw ;save A call print db 'T','o'+80H ;prefix to status display pop psw ;get A ENDIF ;NOISE rrc ;move right 1 bit ani 7fh ;mask msb 0 mov m,a ;store active bit jrnz ifstat ;print status if IF still active ifnderr: IF NOISE call print ;print message db 'N','o'+80H jmp prif ELSE ;NOT NOISE ret ENDIF ;NOISE ; ; FCP Command: ELSE ; ELSE complements the Active Bit for the Current IF ; ; Algorithm: ; If Current IF is 0 (no IF) or 1 (one IF), then toggle ; Active IF Bit associated with Current IF ; Else ; If Previous IF was Active then toggle ; Active IF Bit associated with Current IF ; Else do nothing ; ifelse: IF NOISE call nl ;print new line ENDIF ;NOISE lxi h,z3msg+1 ;pt to IF msgs mov a,m ;get current IF mov b,a ;save current IF in B inx h ;pt to active IF message rrc ;back up to previous IF level ani 7fh ;mask out possible carry jrz iftog ;toggle if IF level is 0 or 1 ana m ;determine previous IF status jrz ifstat ;don't toggle, and just print status iftog: mov a,m ;get active IF message cma ;flip bits ana b ;look at only interested bit mov c,a ;result in C mov a,b ;complement IF byte cma mov b,a mov a,m ;get active byte ana b ;mask in only uninterested bits ora c ;mask in complement of interested bit mov m,a ;save result and fall thru to print status ; ; Indicate if current IF is True or False ; ifstat: IF NOISE call prif mvi b,'F' ;assume False call iftest ;see if IF is FALSE (Z if so) jrz ifst1 ;Zero means IF F or No IF mvi b,'T' ;set True ifst1: mov a,b ;get T/F flag and fall thru to print it ELSE ;NOT NOISE ret ENDIF ;NOISE ; ; 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 ret ; ; Output LF (to go with CR from ZCPR3) ; nl: mvi a,lf ;output LF jr conout ; ; FCP Command: IF ; ifstart: IF NOISE call nl ;print new line ENDIF ;NOISE call iftest ;see if current IF is running and FALSE ; IF NOT COMIF jrz ifcfalse ;raise next IF level to FALSE if so ELSE jz ifcf ENDIF ;NOT COMIF ; ;**************************************************************** ;* * ;* IF.COM Processing * ;* * ;**************************************************************** ; ; If IF.COM to be processed, goto ROOT (base of path) and load it ; IF COMIF ; ; Get Current Disk and User in BC ; lda udflag ;get UD push psw ;save UD flag ani 0fh ;get disk sta cdisk ;set current disk mov b,a ;B=disk (A=0) pop psw ;get UD flag rlc ;get user in low 4 bits rlc rlc rlc ani 0fh ;get user sta cuser ;set current user mov c,a ;... in C ; ; Pt to Start of Path ; lxi h,expath ;pt to path ; ; Check for End of Path ; fndroot: mov a,m ;check for done ora a ;end of path? jrz froot2 ; ; Process Next Path Element ; cpi '$' ;current disk? jrnz froot0 lda cdisk ;get current disk inr a ;+1 for following -1 froot0: dcr a ;set A=0 mov b,a ;set disk inx h ;pt to user mov a,m ;get user cpi '$' ;current user? jrnz froot1 lda cuser ;get current user froot1: mov c,a ;set user inx h ;pt to next jr fndroot ; ; Done with Search - BC Contains ROOT DU ; froot2: ; ; Log Into ROOT ; call logbc ;log into root DU ; ; Set Address of Next Load and Set DMA for OPEN ; lxi h,100h ;pt to TPA shld nxtload ;set address for next load xchg ;DE=100H so don't wipe out buffers mvi c,26 ;set DMA call bdos ; ; Try to Open File IF.COM ; lxi d,extfcb ;pt to FCB mvi c,15 ;open file call bdos inr a ;check for found jz ifnotfnd ; ; Load File IF.COM ; ifload: ; ; Set Load Address ; lhld nxtload ;get address of next load push h ;save it lxi d,80h ;pt to following dad d shld nxtload pop d ;get load address mvi c,26 ;set DMA call bdos ; ; Read in Block (Sector) and Loop Back if Not Done ; lxi d,extfcb ;read file mvi c,20 push d ;save ptr in case of failure (done) call bdos pop d ora a ;OK? jz ifload ; ; Done - Close File ; mvi c,16 ;close file call bdos ; ; Reset Environment (DMA and DU) and Run IF.COM ; call reset ;reset DMA and directory jmp tpa ;run IF.COM ; ; Reset DMA Address and Current Disk (in CDISK) and User (in CUSER) ; reset: lxi d,80h ;reset DMA address mvi c,26 call bdos lda cdisk ;return home mov b,a lda cuser mov c,a ; ; Log Into DU in BC ; logbc: mov e,b ;set disk push b mvi c,14 ;select disk call bdos pop b mov e,c ;set user mvi c,32 ;select user jmp bdos ; ; IF.COM not found - Process as IF F ; ifnotfnd: call reset ;return home jr ifcf ; ; Buffers for COMIF ; nxtload: ds 2 ;address of next block (sector) to load cuser: ds 1 ;current user cdisk: ds 1 ;current disk (A=0) ; ENDIF ;COMIF ; IF NOT COMIF ;**************************************************************** ;* * ;* Non-IF.COM Processing * ;* * ;**************************************************************** ; ; Test for Equality if Enabled ; IF IFOEQ lxi h,tbuff+1 ;look for '=' in line tsteq: mov a,m ;get char inx h ;pt to next ora a ;EOL? jrz ifck0 ;continue if so cpi '=' ;'=' found? jrnz tsteq lxi h,fcb1+1 ;compare FCBs lxi d,fcb2+1 mvi b,11 ;11 bytes eqtest: ldax d ;compare cmp m jrnz ifcf inx h ;pt to next inx d djnz eqtest jr ifct ENDIF ;IFOEQ ; ; Test Condition in FCB1 and file name in FCB2 ; Execute condition processing routine ; ifck0: lxi d,fcb1+1 ;pt to first char in FCB1 ; IF IFONEG ldax d ;get it sta negflag ;set negate flag cpi negchar ;is it a negate? jrnz ifck1 inx d ;pt to char after negchar ifck1: ENDIF ;IFONEG ; IF IFOREG ;REGISTERS call regtest ;test for register value jrnz runreg ENDIF ;IFOREG ; call condtest ;test of condition match jrnz runcond ;process condition call print ;beep to indicate error db bell+80H jmp ifstat ;no condition, display current condition ; ; Process register - register value is in A ; IF IFOREG runreg: push psw ;save value call getnum ;extract value in FCB2 as a number pop psw ;get value cmp b ;compare against extracted value jrz ifctrue ;TRUE if match jr ifcfalse ;FALSE if non-match ENDIF ;IFOREG ; ; Process conditional test - address of conditional routine is in HL ; runcond: pchl ;"call" routine pted to by HL ; ENDIF ;NOT COMIF ; ; ; Condition: NULL (2nd file name) ; IF IFONULL ifcnull: lda fcb2+1 ;get first char of 2nd file name cpi ' ' ;space = null jrz ifctrue jr ifcfalse ENDIF ;IFONULL ; ; Condition: TCAP ; IF IFOTCAP ifctcap: lda z3env+80H ;get first char of Z3 TCAP Entry cpi ' '+1 ;space or less = none jrc ifcfalse jr ifctrue ENDIF ;IFOTCAP ; ; Condition: WHEEL ; IF IFOWHEEL ifcwheel: lhld z3env+29h ;get address of wheel byte mov a,m ;get byte ora a ;test for true jrz ifcfalse ;FALSE if 0 jr ifctrue ENDIF ;IFOWHEEL ; ; Condition: TRUE ; IFCTRUE enables an active IF ; Condition: FALSE ; IFCFALSE enables an inactive IF ; ifctrue: ; IF IFONEG call negtest ;test for negate jrz ifcf ENDIF ;IFONEG ; ifct: mvi b,0ffh ;active jmp ifset ifcfalse: ; IF IFONEG call negtest ;test for negate jrz ifct ENDIF ;IFONEG ; ifcf: mvi b,0 ;inactive jmp ifset ; ; Condition: INPUT (from user) ; IF IFOINPUT ifcinput: lxi h,z3msg+7 ;pt to ZEX message byte mvi m,10b ;suspend ZEX input push h ;save ptr to ZEX message byte IF NOT NOISE call nl ENDIF ;NOT NOISE call prif call print db 'True?',' '+80H mvi c,1 ;input from console call bdos pop h ;get ptr to ZEX message byte mvi m,0 ;return ZEX to normal processing cpi ' ' ;yes? jrz ifctrue ani 5fh ;mask and capitalize user input cpi 'T' ;true? jrz ifctrue cpi 'Y' ;yes? jrz ifctrue cpi CR ;yes? jrz ifctrue jr ifcfalse ENDIF ;IFOINPUT ; ; Condition: EXIST filename.typ ; IF IFOEXIST ifcex: call tlog ;log into DU lxi d,fcb2 ;pt to fcb mvi c,17 ;search for first call bdos inr a ;set zero if error jrz ifcfalse ;return FALSE jr ifctrue ;return TRUE ENDIF ;IFOEXIST ; ; Condition: EMPTY filename.typ ; IF IFOEMPTY ifcempty: call tlog ;log into FCB2's DU lxi d,fcb2 ;pt to fcb2 mvi c,15 ;open file push d ;save fcb ptr call bdos pop d inr a ;not found? jrz ifctrue mvi c,20 ;try to read a record call bdos ora a ;0=OK jrnz ifctrue ;NZ if no read jr ifcfalse ENDIF ;IFOEMPTY ; ; Condition: ERROR ; IF IFOERROR ifcerror: lda z3msg+6 ;get error byte ora a ;0=TRUE jrz ifctrue jr ifcfalse ENDIF ;IFOERROR ; ; **** Support Routines **** ; ; ; Convert chars in FCB2 into a number in B ; IF IFOREG getnum: mvi b,0 ;set number lxi h,fcb2+1 ;pt to first char getn1: mov a,m ;get char inx h ;pt to next sui '0' ;convert to binary rc ;done if error cpi 10 ;range? rnc ;done if out of range mov c,a ;value in C mov a,b ;A=old value add a ;*2 add a ;*4 add b ;*5 add a ;*10 add c ;add in new digit value mov b,a ;result in B jr getn1 ;continue processing ENDIF ;IFOREG ; ; Log into DU in FCB2 ; IF NOT COMIF tlog: lda fcb2 ;get disk ora a ;current? jrnz tlog1 mvi c,25 ;get disk call bdos inr a ;increment for following decrement tlog1: dcr a ;A=0 mov e,a ;disk in E mvi c,14 call bdos lda fcb2+13 ;pt to user mov e,a mvi c,32 ;set user jmp bdos ; ENDIF ;NOT COMIF ; ; Test of Negate Flag = negchar ; IF IFONEG negtest: negflag equ $+1 ;pointer for in-the-code modification mvi a,0 ;2nd byte is filled in cpi negchar ;test for No ret ENDIF ;IFONEG ; ; Test FCB1 against a single digit (0-9) ; Return with register value in A and NZ if so ; IF IFOREG regtest: ldax d ;get digit sui '0' jrc zret ;Z flag for no digit cpi 10 ;range? jrnc zret ;Z flag for no digit lxi h,z3msg+30H ;pt to registers add l ;pt to register mov l,a mov a,h ;add in H aci 0 mov h,a xra a ;set NZ dcr a mov a,m ;get register value ret zret: xra a ;set Z ret ENDIF ;IFOREG ; ; Test to see if a current IF is running and if it is FALSE ; If so, return with Zero Flag Set (Z) ; If not, return with Zero Flag Clear (NZ) ; Affect only HL and PSW ; iftest: lxi h,z3msg+1 ;get IF flag mov a,m ;test for active IF ora a jrz ifok ;no active IF inx h ;pt to active flag ana m ;check active flag rz ;return Z since IF running and FALSE ifok: xra a ;return NZ for OK dcr a ret ; ; Test FCB1 against condition table (must have 2-char entries) ; Return with routine address in HL if match and NZ flag ; IF NOT COMIF condtest: lxi h,condtab ;pt to table condt1: mov a,m ;end of table? ora a rz ldax d ;get char mov b,m ;get other char in B inx h ;pt to next inx d cmp b ;compare entries jrnz condt2 ldax d ;get 2nd char cmp m ;compare jrnz condt2 inx h ;pt to address mov a,m ;get address in HL inx h mov h,m mov l,a ;HL = address xra a ;set NZ for OK dcr a ret condt2: lxi b,3 ;pt to next entry dad b ; ... 1 byte for text + 2 bytes for address dcx d ;pt to 1st char of condition jr condt1 ; ENDIF ;NOT COMIF ; ; Turn on next IF level ; B register is 0 if level is inactive, 0FFH is level is active ; Return with Z flag set if OK ; ifset: lxi h,z3msg+1 ;get IF flag mov a,m ora a ;if no if at all, start 1st one jrz ifset1 cpi 80h ;check for overflow (8 IFs max) jrz iferr inx h ;pt to active IF byte ana m ;check to see if current IF is TRUE jrnz ifset0 ;if TRUE, proceed mvi b,0 ;set False IF ifset0: dcx h ;pt to IF level mov a,m ;get it rlc ;advance to next level ani 0feh ;only 1 bit on mov m,a ;set IF byte jr ifset2 ifset1: inr a ;A=1 mov m,a ;set 1st IF inx h ;clear active IF byte mvi m,0 dcx h ifset2: mov d,a ;get IF byte ana b ;set interested bit mov b,a inx h ;pt to active flag mov a,d ;complement IF byte cma mov d,a mov a,m ;get active byte ana d ;mask in only uninterested bits ora b ;mask in complement of interested bit mov m,a ;save result call ifstat ;print status xra a ;return with Z ret iferr: call print ;beep to indicate overflow db bell+80H xra a ;set NZ dcr a ret ; ; Test for Size Error ; if ($ GT (FCP + FCPS*128)) sizerr equ novalue ;FCP is too large for buffer endif end