home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-07-13 | 30.9 KB | 1,753 lines |
- ;
- ; Program: SHOW
- ; Author: Richard Conn
- ; Version: 1.0
- ; Date: 5 Mar 84
- ;
- version equ 10
- z3env SET 0f400h
-
- ;
- ; The purpose of SHOW is to display various details about the ZCPR3
- ; System to the ZCPR3 user. Details on the ZCPR3 Environment Descriptor,
- ; what facilities are available, and what the status of these facilities
- ; is are included.
- ;
-
- ;
- ; Basic Equates
- ;
- fcb equ 5ch
- cr equ 0dh
- lf equ 0ah
- ctrlc equ 'C'-'@'
- ctrlr equ 'R'-'@'
-
- ;
- ; External References
- ;
- ext envptr
- ext tinit,dinit ;from VLIB
- ext z3vinit,cls,gotoxy,gxymsg,vprint,at ;from VLIB
- ext getiop
- ext retud,pfn1
- ext getpath,dutdir,bbline,eval16
- ext capine,cout,crlf,print,pstr,getmsg,padc,pafdc,phl4hc,pa2hc
- ext shempty,shfull,getsh
- ext geter1,geterc,puter1,puterc
- ext getfcp,getrcp,getefcb
- ext getndr
- ext strtzex,stopzex
-
- ;
- ; Environment Definition
- ;
- if z3env ne 0
- ;
- ; External ZCPR3 Environment Descriptor
- ;
- jmp start
- db 'Z3ENV' ;This is a ZCPR3 Utility
- db 1 ;External Environment Descriptor
- z3eadr:
- dw z3env
- start:
- lhld z3eadr ;pt to ZCPR3 environment
- ;
- else
- ;
- ; Internal ZCPR3 Environment Descriptor
- ;
- MACLIB Z3BASE.LIB
- MACLIB SYSENV.LIB
- z3eadr:
- jmp start
- SYSENV
- start:
- lxi h,z3eadr ;pt to ZCPR3 environment
- endif
-
- ;
- ; Start of Program -- Initialize ZCPR3 Environment
- ;
- call z3vinit ;initialize the ZCPR3 Env and the VLIB Env
- shld dumpstrt ;set beginning address of memory dump
- lda fcb+1 ;check for E option (error handler)
- cpi ' ' ;no option, so proceed
- jz show
- cpi 'E' ;install SHOW as error handler
- jz errins
- call print
- db 'SHOW Version '
- db (version/10)+'0','.',(version mod 10)+'0'
- db cr,lf,'Syntax:'
- db cr,lf,' SHOW <-- Invoke Normally'
- db cr,lf,' SHOW E <-- Install as Error Handler'
- db 0
- ret
- ;
- ; Install SHOW as an error handler
- ;
- errins:
- call getefcb ;pt to name of command
- jnz errins1
- lxi h,showcmd-1 ;pt to command line
- errins1:
- inx h ;pt to first char
- push h ;save ptr
- lxi d,8 ;skip to file type field
- dad d
- mvi m,0 ;store ending 0
- pop h
- call puterc ;store error handler command line
- mvi a,0ffh ;turn on error handlers
- call puter1
- call print
- db 'SHOW Installed as an Error Handler',0
- ret
- ;
- ; Print Menu and Accept Command
- ;
- show:
- call tinit ;init terminal
- call stopzex ;stop ZEX if running
- call banner ;print banner
- call gxymsg
- db 3,31
- db '--> ',1,'SHOW Menu',2,' <--',0
- mvi h,7 ;begin on row 7
- mvi l,10 ;column 10
- shld infoxy
- call dispxy ;position for display
- call vprint
- db ' '
- db ' PACKAGE DATA ',0
- call dispxy ;position for display
- call vprint
- db ' C -- '
- db 1,'Command Packages ',2,0
- call dispxy ;position for display
- call vprint
- db ' I -- '
- db 1,'Input/Output Package',2,0
- call dispxy ;position for display
- call dispxy ;position for display
- call vprint
- db ' '
- db ' ENVIRONMENT ',0
- call dispxy ;position for display
- call vprint
- db ' E -- '
- db 1,'Error Handler ',2,0
- call dispxy ;position for display
- call vprint
- db ' M -- '
- db 1,'Memory Utility ',2,0
- call dispxy ;position for display
- call vprint
- db ' N -- '
- db 1,'Named Directory ',2,0
- call dispxy ;position for display
- call vprint
- db ' P -- '
- db 1,'Path Expression ',2,0
- call dispxy
- call vprint
- db ' S -- '
- db 1,'Shell Stack ',2,0
- mvi h,7 ; row 7
- mvi l,40 ; column 40
- shld infoxy
- call dispxy
- call vprint
- db ' '
- db 'ZCPR3 SYSTEM DATA ',0
- call dispxy
- call vprint
- db ' 1 -- '
- db 1,'Env Descriptor ',2,0
- call dispxy
- call vprint
- db ' 2 -- '
- db 1,'Message Buffers ',2,0
- call dispxy
- call vprint
- db ' 3 -- '
- db 1,'CRT and Printer Data',2,0
- call dispxy
- call vprint
- db ' 4 -- '
- db 1,'System File Defns ',2,0
- call dispxy
- call dispxy
- call dispxy
- call vprint
- db ' X -- '
- db 1,'Exit',2,0
- ;
- ; Input Command from User
- ;
- getcmd:
- call gxymsg ;print prompt
- db 23,10,'SHOW Command? ',0
- call capine ;get command
- getcmd1:
- call ctabscan ;scan for and process command
- call print ;print error message
- db 7,0 ;beep
- jmp getcmd
- ;
- ; Print Banner
- ;
- banner:
- call cls ;clear screen
- call gxymsg ;print banner message
- db 1,27 ;row/col
- db '>>>> '
- db 'SHOW Version '
- db (version/10)+'0','.',(version mod 10)+'0'
- db ' <<<<',0
- ret
- ;
- ; Command Table
- ;
- ctable:
- db '1' ;Env Desc
- dw envdes
- db '2' ;Messages
- dw msg
- db '3' ;CRT and Printer
- dw cpdata
- db '4' ;File Names
- dw fnames
- db 'C' ;Command Package Status
- dw command
- db 'E' ;Error Handler Display
- dw errorh
- db 'I' ;I/O Package Display
- dw iopack
- db 'M' ;Memory Utility
- dw memory
- db 'N' ;Named Directory Data
- dw namedir
- db 'P' ;Path Display
- dw pdisp
- db 'S' ;Shell Stack Display
- dw shstack
- db 'X' ;Exit
- dw exit
- db ctrlc ;Exit
- dw exit
- db cr ;New Screen
- dw show
- db ' ' ;New Screen
- dw show
- db ctrlr ;New Screen
- dw show
- db 0 ;end of table
- ;
- ; Scan for and transfer control to command routine
- ;
- ctabscan:
- lxi h,ctable ;pt to command table
- mov c,a ;command in C
- ctab1:
- mov a,m ;get char from table
- ora a ;done?
- rz
- cmp c ;check for match
- jz ctab2
- inx h ;skip address
- inx h
- inx h ;pt to next command char
- jmp ctab1
- ctab2:
- inx h ;pt to address
- mov a,m ;get low
- inx h
- mov h,m ;get high
- mov l,a ;HL pts to command
- pop psw ;clear stack
- pchl ;"goto" command
- ;
- ; **** Deinitialize Terminal and Exit to ZCPR3 ****
- ;
- exit:
- call strtzex ;resume ZEX if running
- jmp dinit ;deinit terminal
- ;
- ; **** Memory Dumper ****
- ;
- memory:
- call banner
- call gxymsg
- db 3,25
- db '--> ',1,'Memory Display at ',0
- lhld dumpstrt ;start of dump address
- call phl4hc
- call vprint
- db 2,' <--',cr,lf,0
- mvi b,16
- mem1:
- shld cline ;set current line ptr
- call crlf ;new line
- call phl4hc ;print address
- call vprint
- db 1,' --',2,0
- mvi c,16 ;count for elements
- mem2:
- mov a,c ;extra space?
- ani 3
- mvi a,' ' ;extra space
- cz cout
- mov a,m ;get next byte
- call pa2hc ;print as hex
- mvi a,' ' ;space
- call cout
- inx h ;pt to next
- dcr c ;count down
- jnz mem2
- call vprint
- db 1,'| ',2,0
- lhld cline ;pt to current line again
- mvi c,16 ;count again
- mem3:
- mov a,m ;get next byte
- ani 7fh ;mask MSB
- cpi ' '
- jnc mem4
- mvi a,'.' ;dot fill
- mem4:
- call cout
- inx h ;pt to next
- dcr c ;count down
- jnz mem3
- dcr b ;count down major loop
- jnz mem1
- call gxymsg ;print prompt
- db 23,10
- db 1,'Command (<=last, >=next, A=adr, SHOW Cmd)? ',2,0
- call capine ;get input
- cpi 'A' ;address?
- jz memadr
- cpi '>' ;advance?
- jz memnext
- cpi '.' ;advance?
- jz memnext
- cpi '<' ;backup?
- jz memback
- cpi ',' ;backup?
- jz memback
- jmp getcmd1 ;process otherwise
- memadr:
- call print
- db 'ddress (Hex)? ',0
- mvi a,0ffh ;capitalize
- call bbline ;get line from user
- mema1:
- mov a,m ;skip leading spaces
- inx h ;pt to next char
- cpi ' '
- jz mema1
- dcx h ;pt to first char
- call eval16 ;evaluate as hex
- xchg ;result in HL
- shld dumpstrt ;set new start address
- jmp memory ;restart
- memnext:
- lhld dumpstrt ;advance 1 page
- inr h
- shld dumpstrt
- jmp memory ;restart
- memback:
- lhld dumpstrt ;backup 1 page
- dcr h
- shld dumpstrt
- jmp memory ;restart
- ;
- ; **** ZCPR3 Messages ****
- ;
- msg:
- call banner
- call gxymsg
- db 3,25
- db '--> ',1,'ZCPR3 System Messages',2,' <--',0
- mvi h,5 ; row 5
- mvi l,5 ; column 5
- shld infoxy
- mvi a,22h ; offset
- call compenv ; pt to address of messages
- mov a,m
- inx h
- mov h,m
- mov l,a ; HL pts to first message
- call dispxy
- call vprint
- db 1,'Error Handler Defined? ',2,0
- mov a,m ; get flag
- call pryn
- mov a,m ; get flag again
- ora a ; defined?
- jz msg1
- push h
- lxi d,10h ; pt to error command line
- dad d
- call dispxy
- call vprint
- db 1,' Error Handler: ',2,0
- call pstr
- pop h
- msg1:
- inx h
- call dispxy
- call dispxy
- call vprint
- db 1,'Current IF Level: ',2,0
- mvi b,8 ; set IF count
- mov c,m ; get IF flag
- iftst:
- mov a,c ; get flag
- rlc
- mov c,a ; save flag
- jc iftst1
- dcr b ; count down
- jnz iftst
- iftst1:
- mov a,b ; get char
- call padc
- inx h ; pt to IF active flag
- inx h ; pt to command status
- shld cstat ; save address
- inx h ; pt to error address
- inx h
- inx h ; pt to program error code
- call dispxy
- call dispxy
- call vprint
- db 1,'Program Error Code: ',2,0
- mov a,m
- call padc
- inx h ; pt to ZEX message byte
- inx h ; pt to ZEX running flag
- call dispxy
- call dispxy
- call vprint
- db 1,'ZEX Running? ',2,0
- mov a,m
- call pryn
- mov a,m ; make sure we have char
- inx h ; skip ZEX data
- inx h
- inx h
- ora a ; ZEX running?
- jz nozex
- mov e,m ; get low-order
- inx h
- mov d,m ; get high-order
- call dispxy
- call vprint
- db 1,'Address of ZEX Buffer: ',2,0
- xchg
- call phl4hc ; print address
- xchg
- jmp scb ; process shell control byte now
- nozex:
- inx h
- scb:
- inx h ; pt to shell control byte
- push h
- mvi h,5 ; row 5
- mvi l,40 ; column 40
- shld infoxy
- pop h
- call dispxy
- call vprint
- db 1,'Shell Control --',2,0
- call dispxy
- call vprint
- db 1,' Enable Shell Comment? ',2,0
- mov a,m
- ani 1
- call pryn
- call dispxy
- call vprint
- db 1,' Enable Shell Echo? ',2,0
- mov a,m
- ani 10b
- call pryn
- call dispxy
- call vprint
- db 1,' Enable Shell Wait? ',2,0
- mov a,m
- ani 80h
- call pryn
- push h ; save ptr to next message byte
- lhld cstat ; get ptr to command status
- call dispxy
- call dispxy
- call vprint
- db 1,'Command Status: ',2,0
- mov a,m ; get it
- ani 3 ; 2 LSBs
- jz csnorm
- cpi 1
- jz csshell
- call print
- db 'Error',0
- inx h ; pt to error address
- mov a,m ; get low
- inx h
- mov h,m ; get high
- mov l,a
- call dispxy
- call vprint
- db 1,' Error Command ',2,0
- call dispxy
- call print
- db ' ',0
- erprt:
- mov a,m ; get char
- cpi ' '+1 ; end of command with space or less?
- jc csdone
- cpi ';' ; end of command with new command?
- jz csdone
- call cout ; print char
- inx h
- jmp erprt
- csnorm:
- call print
- db 'Normal',0
- jmp csdone
- csshell:
- call print
- db 'Shell',0
- csdone:
- pop h ; restore ptr
- lxi d,35 ; jump to registers
- dad d
- push h
- mvi h,17 ; row 17
- mvi l,5 ; column 5
- shld infoxy
- pop h
- call dispxy
- call vprint
- db 1,'Registers --',2,0
- call dispxy ; new line
- mvi b,10 ; 10 times
- mvi c,0
- regl:
- call vprint
- db 1,' ',0
- mvi a,10+'0' ; compute reg char
- sub b ; get value
- call cout
- call vprint
- db '=',2,0
- mov a,m ; get value
- inx h ; pt to next
- call padc ; print
- inr c ; every 4
- mov a,c ; get count
- ani 3
- cz dispxy ; new line
- dcr b ; count down
- jnz regl
- lxi d,6 ; skip to user-defined values
- dad d
- push h
- mvi h,17 ; row 17
- mvi l,40 ; column 40
- shld infoxy
- pop h
- call dispxy
- call vprint
- db 1,'User-Defined Area --',2,0
- call dispxy ; new line
- mvi b,16 ; 16 times
- mvi c,0
- regl1:
- call vprint
- db ' ',0
- mov a,m ; get value
- inx h ; pt to next
- call padc ; print
- inr c ; every 4
- mov a,c ; get count
- ani 3
- cz dispxy ; new line
- dcr b ; count down
- jnz regl1
- jmp getcmd
- ;
- ; **** System File Definitions ****
- ;
- fnames:
- call banner
- call gxymsg
- db 3,27
- db '--> ',1,'System File Names',2,' <--',0
- mvi h,5 ; row 5
- mvi l,24 ; column 24
- shld infoxy
- call dispxy
- call vprint
- db 1,'Shell Variable File: ',2,0
- mvi a,47h ; offset
- call compenv
- xchg ; DE pts to file name
- call pfn ; print file name
- call dispxy
- mvi b,'1' ; set counter
- fnames1:
- lxi h,11 ; offset to next file
- dad d ; pt to next file name
- xchg
- call dispxy
- call vprint
- db 1,'File Name ',0
- mov a,b
- call cout ; print number
- call vprint
- db ': ',2,0
- call pfn ; print file name
- inr b ; next name
- mov a,b ; get next
- cpi '4'+1 ; done?
- jnz fnames1
- jmp getcmd
- ;
- ; Print File Name for FNAMES
- ;
- pfn:
- ldax d ; get first char
- cpi ' ' ; none?
- jnz pfn1 ; print name
- lxi h,8 ; check type
- dad d
- mov a,m ; get first char of type
- cpi ' ' ; none?
- jnz pfn1 ; print name
- call print
- db 'Undefined',0
- ret
- ;
- ; **** CRT and Printer Data ****
- ;
- cpdata:
- call banner
- call gxymsg
- db 3,26
- db '--> ',1,'CRT and Printer Data',2,' <--',0
- mvi h,5 ; row 5
- mvi l,5 ; column 5
- shld infoxy
- call dispxy
- call vprint
- db 1,'CRT -- Selection: ',2,0
- mvi a,2fh ; offset
- call prbyte ; print byte value there
- call dispxy
- call vprint
- db 1,' CRT 0',2,0
- mvi a,31h ; print data at 31H
- call cprt
- call dispxy
- call dispxy
- call vprint
- db 1,'LST -- Selection: ',2,0
- mvi a,30h ; offset
- call prbyte ; print byte value there
- call dispxy
- call vprint
- db 1,' LST 0',2,0
- mvi a,37h ; offset
- call lprt
- call dispxy
- call dispxy
- call vprint
- db 1,' LST 2',2,0
- mvi a,3fh ; offset
- call lprt
- mvi h,6 ; row 6
- mvi l,40 ; column 40
- shld infoxy
- call dispxy
- call vprint
- db 1,' CRT 1',2,0
- mvi a,34h ; print data at 34H
- call cprt
- call dispxy
- call dispxy
- call dispxy
- call vprint
- db 1,' LST 1',2,0
- mvi a,3bh ; offset
- call lprt
- call dispxy
- call dispxy
- call vprint
- db 1,' LST 3',2,0
- mvi a,43h ; offset
- call lprt
- jmp getcmd
- ;
- ; Print CRT Data
- ;
- cprt:
- call compenv ; compute offset
- call dispxy
- call vprint
- db 1,' Width: ',2,0
- mov a,m
- call padc
- call vprint
- db ' Cols',0
- call dispxy
- call vprint
- db 1,' Lines/Text: ',2,0
- inx h
- mov a,m
- call padc
- call vprint
- db ' / ',0
- inx h
- mov a,m
- call padc
- ret
- ;
- ; Print LST Data
- ;
- lprt:
- call compenv ; compute offset
- call dispxy
- call vprint
- db 1,' Width: ',2,0
- mov a,m
- call padc
- call vprint
- db ' Cols',0
- call dispxy
- call vprint
- db 1,' Lines/Text: ',2,0
- inx h
- mov a,m
- call padc
- call vprint
- db ' / ',0
- inx h
- mov a,m
- call padc
- inx h
- call dispxy
- call vprint
- db 1,' Form Feed? ',2,0
- mov a,m
- call pryn
- ret
-
- ;
- ; **** Print Environment Descriptor Data ****
- ;
- envdes:
- call banner
- call gxymsg
- db 3,25
- db '--> ',1,'Environment Descriptor',2,' <--',0
- mvi h,5 ; row 5
- mvi l,5 ; column 5
- shld infoxy
- call dispxy
- call vprint
- db 1,'>> Addresses <<',2,0
- call dispxy
- call vprint
- db 1,' Command Line Buffer: ',2,0
- mvi a,18h ; offset
- call pradr ; print address
- call dispxy
- call vprint
- db 1,' Command-Search Path: ',2,0
- mvi a,9 ; offset
- call pradr ; print address
- call dispxy
- call vprint
- db 1,' Environment Descriptor: ',2,0
- lhld envptr ; get ptr
- call phl4hc
- call dispxy
- call vprint
- db 1,' Externals --',2,0
- call dispxy
- call vprint
- db 1,' File Control Block: ',2,0
- mvi a,24h
- call pradr
- call dispxy
- call vprint
- db 1,' System Stack: ',2,0
- mvi a,26h
- call pradr
- call dispxy
- call vprint
- db 1,' Message Buffer: ',2,0
- mvi a,22h
- call pradr
- call dispxy
- call vprint
- db 1,' Named Directory Buffer: ',2,0
- mvi a,15h
- call pradr
- call dispxy
- call vprint
- db 1,' Packages --',2,0
- call dispxy
- call vprint
- db 1,' Flow Command: ',2,0
- mvi a,12h
- call pradr
- call dispxy
- call vprint
- db 1,' Input/Output: ',2,0
- mvi a,0fh
- call pradr
- call dispxy
- call vprint
- db 1,' Resident Command: ',2,0
- mvi a,0ch
- call pradr
- call dispxy
- call vprint
- db 1,' Shell Stack Buffer: ',2,0
- mvi a,1eh
- call pradr
- call dispxy
- call vprint
- db 1,' Wheel Byte: ',2,0
- mvi a,29h
- call pradr
- mvi h,5 ; row 5
- mvi l,40 ; column 40
- shld infoxy
- call dispxy
- call vprint
- db 1,'>> Data Elements <<',2,0
- call dispxy
- call vprint
- db 1,' Sizes --',2,0
- call dispxy
- call vprint
- db 1,' Command Line: ',2,0
- mvi a,1ah
- call prbyte
- call vprint
- db ' Chars',0
- call dispxy
- call vprint
- db 1,' External Path: ',2,0
- mvi a,0bh
- call prbyte
- call vprint
- db ' Elts',0
- call dispxy
- call vprint
- db 1,' Named Dir Entries: ',2,0
- mvi a,17h
- call prbyte
- call dispxy
- call vprint
- db 1,' Package, FCP: ',2,0
- mvi a,14h
- call prbyte
- call pr128
- call dispxy
- call vprint
- db 1,' Package, IOP: ',2,0
- mvi a,11h
- call prbyte
- call pr128
- call dispxy
- call vprint
- db 1,' Package, RCP: ',2,0
- mvi a,0eh
- call prbyte
- call pr128
- call dispxy
- call vprint
- db 1,' Shell Stack Elts: ',2,0
- mvi a,20h
- call prbyte
- call dispxy
- call dispxy
- call vprint
- db 1,' DU Form Allowed? ',2,0
- mvi a,2eh
- call compenv
- mov a,m ; get byte
- call pryn
- call dispxy
- call vprint
- db 1,' Max Disk and User: ',2,0
- mvi a,2ch
- call compenv
- mov a,m
- adi '@'
- call cout
- inx h
- mov a,m
- call pafdc
- call dispxy
- call vprint
- db 1,' Processor Speed: ',2,0
- mvi a,2bh
- call prbyte
- call vprint
- db ' MHz',0
- call dispxy
- call vprint
- db 1,' Quiet Operation? ',2,0
- mvi a,28h
- call compenv
- mov a,m ; get byte
- call pryn
- jmp getcmd
- ;
- ; Print 128-Byte Block Message
- ;
- pr128:
- call vprint
- db ' Blocks',0
- ret
- ;
- ; Print address pted to by A offset as 4 hex chars
- ;
- pradr:
- call compenv ; pt to address
- mov e,m ; get address
- inx h
- mov d,m
- xchg
- jmp phl4hc
- ;
- ; Print byte pted to by A offset as dec chars
- ;
- prbyte:
- call compenv ; compute offset (in HL)
- mov a,m ; get byte
- jmp padc
- ;
- ; Add A to Base Address in ENVPTR
- ; Return Result in HL
- ;
- compenv:
- lhld envptr ; get base address
- add l ; add offset
- mov l,a
- mov a,h
- aci 0
- mov h,a
- ret
- ;
- ; **** Display Input/Output Package Function ****
- ;
- iopack:
- call banner
- call gxymsg
- db 3,26
- db '--> ',1,'Input/Output Package',2,' <--',0
- call getiop ;check for initialization
- mov a,h
- ora l ;must NOT be zero
- jnz iopack0
- call gxymsg
- db 5,23,'Input/Output Packages Not Available',0
- jmp getcmd
- iopack0:
- call status ;check for drivers
- jnz iopack1
- call gxymsg
- db 5,22,'Input/Output Redirection Not Available',0
- jmp getcmd
- iopack1:
- call dispcon ;successive displays
- call disprdr
- call gxymsg
- db 23,10,'Strike Any Key For Next Screen - ',0
- call capine
- call banner
- call gxymsg
- db 3,26
- db '--> ',1,'Input/Output Package',2,' <--',0
- call disppun
- call displst
- jmp getcmd
- dispcon:
- call vprint
- db cr,lf,cr,lf,1,'Console',0
- mvi a,0 ;select CON:
- call disp
- jmp curr
- displst:
- call vprint
- db cr,lf,cr,lf,1,'Printer',0
- mvi a,3 ;select LST:
- call disp
- jmp curr
- disprdr:
- call vprint
- db cr,lf,cr,lf,1,'Reader ',0
- mvi a,1 ;select RDR:
- call disp
- jmp curr
- disppun:
- call vprint
- db cr,lf,cr,lf,1,'Punch ',0
- mvi a,2 ;select PUN:
- call disp
- ;
- ; Print Name of Current Device
- ;
- curr:
- push h ;save ptr
- mov b,a ;save number in B
- push b ;save B
- call vprint
- db cr,lf,1,' Assignment is ',2,0
- push b ;save B
- call status ;get status
- pop b ;get B
- inr b ;add 1 for offset
- dcx h ;back up
- curr1:
- inx h ;pt to next
- inx h
- dcr b ;count down
- jnz curr1
- pop b ;get logical number in B
- mov c,m ;get physical number in C
- call pname0 ;print first part of name only
- pop h ;get ptr
- ret
- ;
- ; Print Names of All Physical Devices for a Logical Device
- ;
- disp:
- push h ;save char ptr
- push psw ;save device number
- call vprint
- db ' Devices --',2,0
- mov b,a ;logical device in B
- push b ;save for later
- push b ;save it
- call status ;get status report
- pop b ;get logical device number
- inr b ;add 1 for offset
- dcx h ;back up
- dcx h
- disp1:
- inx h ;pt to next
- inx h
- dcr b ;count down
- jnz disp1
- pop b ;get B back
- mov c,m ;get count of devices
- mov a,c ;check for none
- ora a
- jz disp3
- disp2:
- push b ;save values
- dcr c ;pt to next name
- call print
- db cr,lf,' ',0
- call pnamer ;print name (B=logical, C=physical)
- pop b ;get count
- dcr c ;count down
- jnz disp2
- disp3:
- pop psw
- pop h
- ret
- ;
- ; Routine to Print Name of Selected Device
- ; B=logical number, C=physical number
- ;
- pnamer:
- push b ;save BC
- call pname0 ;print first part of name
- call vprint ;print separator
- db 1,' - ',2,0
- call pstr ;print rest as string
- pop b ;restore BC
- ret
- ;
- ; Print first part of selected device name
- ;
- pname0:
- call namer ;get ptr to string
- mvi b,8 ;at most 8 chars
- pname1:
- mov a,m ;get char
- inx h ;pt to next char
- cpi ' ' ;end of name?
- jz pname2
- call cout ;print char
- dcr b ;count down
- jnz pname1
- ret
- pname2:
- mvi a,' ' ;print spaces
- call cout
- dcr b ;count down
- jnz pname2
- ret
-
- ;
- ; Basic Interface Routines
- ;
- status:
- lxi d,0 ;Offset 0
- runit:
- call getiop ;device driver base
- dad d
- pchl
- select:
- lxi d,3 ;Offset 3
- jmp runit
- namer:
- lxi d,6 ;Offset 6
- jmp runit
-
- ;
- ; **** Display Path Function ****
- ;
- pdisp:
- call banner
- call gxymsg
- db 3,28
- db '--> ',1,'Path Expressions',2,' <--',0
- mvi h,6 ; row 6
- mvi l,10 ; column 10
- shld infoxy
- call dispxy
- call vprint
- db 1,'Symbolic Form',2,0
- call dispxy
- call vprint
- db ' ',0
- call getpath ; pt to external path
- pdisp1:
- mov a,m ; get disk
- ora a ; done?
- jz adisp
- cpi '$' ; current?
- jz pdisp2
- adi '@' ; convert to letter
- pdisp2:
- call cout ; print disk letter
- inx h ; pt to user
- mov a,m ; get user number
- cpi '$' ; current?
- jnz pdisp3
- call cout ; print current indicator
- jmp pdisp4
- pdisp3:
- call pafdc ; print user number
- pdisp4:
- call colon
- inx h ; pt to next element
- mov a,m ; done?
- ora a ; 0=yes
- cnz arrow
- jmp pdisp1
- ;
- ; Print Absolute Path
- ;
- adisp:
- call dispxy
- call dispxy
- call vprint
- db 1,'DU Form ',2,0
- call dispxy
- call vprint
- db ' ',0
- call retud ; get current user/disk
- call getpath ; pt to external path
- adisp1:
- mov a,m ; get disk
- ora a ; done?
- jz ndisp
- cpi '$' ; current?
- jnz adisp2
- mov a,b ; get current disk
- inr a ; adjust to 1 to n
- adisp2:
- adi '@' ; convert to letter
- call cout ; print disk letter
- inx h ; pt to user
- mov a,m ; get user
- cpi '$' ; current?
- jnz adisp3
- mov a,c ; get current user
- adisp3:
- call pafdc ; print user
- call colon
- inx h ; pt to next
- mov a,m ; done?
- ora a
- cnz arrow
- jmp adisp1
- ;
- ; Print Named Path
- ;
- ndisp:
- call dispxy
- call dispxy
- call vprint
- db 1,'DIR Form ',2,0
- call dispxy
- call vprint
- db ' ',0
- call getpath ; pt to external path
- ndisp1:
- call retud ; get current user and disk in C and B
- mov a,m ; get disk
- ora a ; done?
- jz getcmd
- cpi '$' ; current?
- jz ndisp2
- mov b,a ; disk in B
- dcr b ; adjust to 0 to n-1
- ndisp2:
- inx h ; pt to user
- mov a,m ; get it
- cpi '$' ; current?
- jz ndisp3
- mov c,a ; user in C
- ndisp3:
- inx h ; pt to next
- push h ; save ptr
- call udscan ; scan dirs for user/disk and print its name
- pop h ; get ptr
- call colon
- mov a,m ; done?
- ora a
- cnz arrow
- jmp ndisp1
-
- ;
- ; Print Colon
- ;
- colon:
- mvi a,':' ; print colon
- jmp cout
-
- ;
- ; Print Arrow
- ;
- arrow:
- call vprint
- db 1,' --> ',2,0
- ret
-
- ;
- ; Scan directories for user and disk in C and B
- ; Print name if found or "Noname" if not
- ;
- udscan:
- call dutdir ; convert to name
- jz udscan1 ; error return if no name
- mvi b,8 ; 8 chars max
- udsprn:
- mov a,m ; get name char
- cpi ' ' ; done?
- rz
- call cout ; print char
- inx h ; pt to next
- dcr b ; count down
- jnz udsprn
- ret
- udscan1:
- call vprint
- db 'Noname',0
- ret
-
- ;
- ; **** Print Named Directory Info ****
- ;
- namedir:
- call banner
- call gxymsg
- db 3,26
- db '--> ',1,'Named Directory Data',2,' <--',0
- call getndr ;get location of directory
- jnz ndir1
- call gxymsg
- db 5,22
- db 'Named Directory Buffer Not Available',0
- jmp getcmd
- ;
- ; Print Names of Directory Elements
- ;
- ndir1:
- call gxymsg
- db 5,25
- db '-- Named Directory Entries --',0
- mvi d,7 ;set row
- mvi e,7 ;set column
- xchg
- call gotoxy ;position cursor
- xchg
- mvi c,0 ;set entry count
- mvi b,1 ;set disk 1
- ;
- ; Print Each Resident Command Name
- ;
- ndir2:
- mov a,m ;get table entry
- ora a ;end of table?
- jz getcmd
- ;
- ; DE is carried over all of this as starting row/column
- ;
- cmp b ;same disk?
- jz ndir3
- ;
- ; Advance to Next Set of Entries for New Disk
- ;
- mvi c,0 ;reset counter
- mov b,a ;set new disk
- xchg ;position for new disk
- inr h ;blank line
- inr h
- call gotoxy ;position on screen
- xchg
- ndir3:
- push b ;save counters
- ;
- ; Print DU:
- ;
- mov a,m ;get disk
- adi '@' ;convert to letter (A to P)
- call cout
- inx h ;pt to user
- mov a,m ;get user
- call padc ;print user number
- call print ;print separator
- db ': ',0
- inx h ;pt to name
- ;
- ; Print DIR
- ;
- mvi b,8 ;print name
- ndir4:
- mov a,m ;get char
- call cout
- inx h ;pt to next
- dcr b ;count down
- jnz ndir4
- ;
- ; Advance to Next and Print Separator
- ;
- lxi b,8 ;skip over password
- dad b
- call print ;print separator
- db ' ',0
- pop b ;get counters
- ;
- ; New Line Counter
- ;
- inr c ;increment entry counter
- mov a,c ;check for done
- ani 3 ;every 4
- jnz ndir2
- ;
- ; Position in Next Line
- ;
- xchg ;position cursor
- inr h ;next row
- call gotoxy
- xchg
- jmp ndir2
-
- ;
- ; **** Print Command Status ****
- ;
- command:
- call banner
- call gxymsg
- db 3,25
- db '--> ',1,'Command Package Status',2,' <--',0
- call gxymsg
- db 5,25
- db '---- ',1,'FLOW COMMAND PACKAGE',2,' ----',0
- call getfcp ;get FCP data
- jnz flow0
- call gxymsg
- db 7,20
- db 'Flow Command Facility Not Available',0
- jmp rcp
- ;
- ; Check for Flow Command Package Loaded
- ;
- flow0:
- mov a,m ;get first byte
- ora a ;0=none loaded
- jnz flow1
- call gxymsg
- db 7,25
- db 'No Flow Command Package Loaded',0
- jmp rcp
- ;
- ; Print Flow Command Package Info
- ;
- flow1:
- call gxymsg
- db 7,20
- db 1,'Flow Commands:',2,0
- lxi d,5 ;skip to command size byte
- dad d
- mov b,m ;get command size
- inx h ;pt to first command
- call at
- db 8,22
- ;
- ; Print Flow Command Names
- ;
- flow2:
- mov a,m ;get first char
- ora a ;end of table?
- jz flow4
- push b ;save counter
- flow3:
- mov a,m ;get char
- inx h ;pt to next
- call cout ;print char
- dcr b ;count down
- jnz flow3
- call print
- db ' ',0
- inx h ;skip over address
- inx h
- pop b ;get counter
- jmp flow2
- ;
- ; Print Flow Command Arguments
- ;
- flow4:
- call gxymsg
- db 9,20
- db 1,'IF Options:',2,0
- call at
- db 10,22
- inx h ;pt to first option
- ;
- ; Print Each Option
- ;
- flow5:
- mov a,m ;get next char
- ora a ;done?
- jz flow6
- call cout ;print char
- inx h ;pt to 2nd char
- mov a,m ;get it and print
- call cout
- call print
- db ' ',0 ;space over
- inx h ;skip address
- inx h
- inx h
- jmp flow5
- ;
- ; Print Current IF Level
- ;
- flow6:
- call gxymsg
- db 11,20
- db 1,'Current IF Level: ',2,0
- call getmsg ;pt to ZCPR3 messages
- inx h ;pt to IF byte
- mov a,m ;get IF byte
- mvi c,'0' ;assume level 0
- ora a ;see if at last IF level
- jz flow8
- flow7:
- inr c ;advance to next level
- rrc ;rotate bits
- ani 7fh ;mask out MSB
- jnz flow7 ;continue looping until no 1 bits
- flow8:
- mov a,c ;get digit
- call cout ;print it
- ;
- ; Print RCP Data
- ;
- rcp:
- call gxymsg
- db 14,23
- db '---- ',1,'RESIDENT COMMAND PACKAGE',2,' ----',0
- call getrcp ;get RCP data
- jnz rcp0
- call gxymsg
- db 16,20
- db 'Resident Command Facility Not Available',0
- jmp getcmd
- ;
- ; Check for Resident Command Package Loaded
- ;
- rcp0:
- mov a,m ;get first byte
- ora a ;0=none loaded
- jnz rcp1
- call gxymsg
- db 16,23
- db 'No Resident Command Package Loaded',0
- jmp getcmd
- ;
- ; Print Resident Command Package Info
- ;
- rcp1:
- call gxymsg
- db 16,20
- db 1,'Resident Commands:',2,0
- lxi d,5 ;skip to command size byte
- dad d
- mov b,m ;get command size
- mvi c,0 ;set count
- inx h ;pt to first command
- mvi d,17 ;set row
- mvi e,22 ;set column
- xchg
- call gotoxy ;position cursor
- xchg
- ;
- ; Print Each Resident Command Name
- ;
- rcp2:
- mov a,m ;get table entry
- ora a ;end of table?
- jz getcmd
- push b ;save counters
- rcp3:
- mov a,m ;get char
- inx h ;pt to next
- call cout
- dcr b ;count down
- jnz rcp3
- call print
- db ' ',0
- inx h ;pt to next command
- inx h
- pop b ;get counters
- inr c ;increment entry counter
- mov a,c ;check for done
- ani 7 ;every 8
- jnz rcp2
- xchg ;position cursor
- inr h ;next row
- call gotoxy
- xchg
- jmp rcp2
-
- ;
- ; **** Print Error Handler Data ****
- ;
- errorh:
- call banner
- call gxymsg
- db 3,27
- db '--> ',1,'Error Handler Data',2,' <--',0
- call getmsg ;get message address
- jnz errh1
- call gxymsg
- db 5,20
- db 'ZCPR3 Messages Not Available on this System',0
- jmp getcmd
- errh1:
- call gxymsg
- db 5,27
- db 1,'Error Handler Engaged? ',2,0
- call geter1 ;error handler engaged?
- push psw
- call pryn ;print yes/no
- pop psw
- jz getcmd ;exit display
- call gxymsg
- db 6,27
- db 1,'Error Handler Command: ',2,0
- call geterc ;get command line
- call pstr
- call gxymsg
- db 7,30
- db 1,'Command Status: ',2,0
- mvi a,22h ; offset to message ptr
- call compenv ; pt to message ptr
- mov a,m
- inx h
- mov h,m
- mov l,a ; HL pts to messages
- inx h ; pt to command status message
- inx h
- inx h
- mov a,m ; get it
- ani 3 ; 2 LSBs
- jz errh3
- cpi 1
- jz errh4
- call print
- db 'Error',0
- inx h ; pt to error address
- mov a,m ; get low
- inx h
- mov h,m ; get high
- mov l,a
- call gxymsg
- db 9,5
- db 1,'Error Command --',2,0
- call vprint
- db cr,lf,1,' --> ',2,0
- errh2:
- mov a,m ; get char
- inx h ; pt to next
- ora a ; end of line?
- jz errh5
- cpi ';' ; end of command with new command?
- jnz errh2a
- call vprint
- db 1,';',2,cr,lf,1,' --> ',2,0
- jmp errh2
- errh2a:
- call cout ; print char
- jmp errh2
- errh3:
- call print
- db 'Normal',0
- jmp errh5
- errh4:
- call print
- db 'Shell',0
- errh5:
- jmp getcmd
-
- ;
- ; **** Print Shell Stack Data ****
- ;
- shstack:
- call banner
- call gxymsg
- db 3,28
- db '--> ',1,'Shell Stack Data',2,' <--',0
- call getsh ;get shell data
- jnz shs0
- call gxymsg
- db 5,20
- db 'Shell Stack NOT Available on this System',0
- jmp getcmd
- ;
- ; Print Empty/Full Messages
- ;
- shs0:
- call gxymsg
- db 5,30
- db 'Shell Stack Empty? ',0
- call shempty
- jz shsem
- mvi a,0 ; set not empty
- jmp shsnem
- shsem:
- mvi a,1 ; set empty
- shsnem:
- call pryn
- call gxymsg
- db 6,30
- db 'Shell Stack Full? ',0
- call shfull
- jz shsfu
- mvi a,0 ; set not full
- jmp shsnfu
- shsfu:
- mvi a,1 ; set full
- shsnfu:
- call pryn
- ;
- ; Print Shell Stack Content Data
- ;
- call gxymsg
- db 8,27
- db '--- Shell Stack Content ---',0
- mvi h,10 ;row 10
- mvi l,20 ;col 20
- shld infoxy ;save position
- call getsh ;get shell stack data
- mov e,b ;get element size in DE
- mvi d,0
- mov b,a ;get element count in B
- mvi c,'1' ;get digit in C
- shs1:
- mov a,m ;check for element in stack
- ora a ;0=empty
- jz shs2
- call dispxy ;position for display
- call vprint
- db 1,'Elt ',0
- mov a,c ;get digit
- call cout ;print as decimal
- inr c ;next digit
- call vprint
- db ' -- ',2,0
- push h
- call pstr ;print entry
- pop h
- dad d ;pt to next
- dcr b ;count down
- jnz shs1
- shs2:
- mov a,c ;see if anything printed
- cpi '1'
- jnz getcmd
- lhld infoxy ;position on screen
- call gotoxy
- call print
- db ' Empty',0
- jmp getcmd
-
- ;
- ; Position Display at INFOXY address and advance
- ;
- dispxy:
- push h ;save HL
- lhld infoxy ;get screen position
- call gotoxy ;go there
- inr h ;advance to next line
- shld infoxy ;set screen position
- pop h ;restore HL
- ret
- ;
- ; If A=0, print Yes, else print No
- ;
- pryn:
- ora a
- jnz pryes
- call print
- db 'NO',0
- ret
- pryes:
- call print
- db 'YES',0
- ret
-
- ;
- ; Buffers
- ;
- showcmd:
- db 'SHOW ',0
- infoxy:
- ds 2 ;address on screen of next line to print
- cstat:
- ds 2 ;command status ptr
- dumpstrt:
- ds 2 ;address of next byte to start memory dump
- cline:
- ds 2 ;address of current line
-
- end