mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-26 09:54:20 +00:00
Upload
Digital Research
This commit is contained in:
@@ -0,0 +1,239 @@
|
||||
|
||||
title 'Clock process'
|
||||
|
||||
;*****************************************************
|
||||
;*
|
||||
;* CLOCK RSP
|
||||
;*
|
||||
;* The clock process will update the CCP/M-86 Time of
|
||||
;* Day structure each time it returns from waiting for
|
||||
;* the 'Second' System Flag (Flag 2). When the minute
|
||||
;* is updated, the 'minute' flag is set (Flag 3).
|
||||
;*
|
||||
;*****************************************************
|
||||
|
||||
|
||||
; ccpm functions
|
||||
|
||||
ccpmint equ 224 ; ccpm entry interrupt
|
||||
dev_flagwait equ 132 ; flagwait
|
||||
dev_flagset equ 133 ; flagset
|
||||
|
||||
|
||||
rlr equ 68H ; Ready List Root
|
||||
ccb equ 54H ; VCCB list
|
||||
|
||||
ccblen equ 2CH ; vccb length
|
||||
|
||||
xiosentry equ 28H ; offset of double word pointer in
|
||||
; the system data segment of XIOS entry
|
||||
io_statline equ 8 ; update XIOS status line
|
||||
|
||||
npcons equ 9fh ; number of physical consoles
|
||||
|
||||
tod_offset equ 07Eh
|
||||
sec_flag equ 2
|
||||
min_flag equ 3
|
||||
|
||||
; TOD format
|
||||
|
||||
tod_day equ word ptr 0
|
||||
tod_hour equ byte ptr 2
|
||||
tod_min equ byte ptr 3
|
||||
tod_sec equ byte ptr 4
|
||||
|
||||
; PD fields
|
||||
|
||||
p_uda equ 10h ; offset of UDA segment in PD
|
||||
pdlen equ 48 ; length of process descriptor
|
||||
|
||||
ps_run equ 0 ; PD run status
|
||||
pf_keep equ 2 ; PD nokill flag
|
||||
|
||||
|
||||
; RSP format
|
||||
|
||||
rsp_top equ 0 ; rsp offset
|
||||
rsp_pd equ 010h ; PD offset
|
||||
rsp_uda equ 040h ; UDA offset
|
||||
|
||||
rsp_bottom equ 140h ; end rsp header
|
||||
|
||||
;*****************************************************
|
||||
;*
|
||||
;* CLOCK CODE SEGMENT
|
||||
;*
|
||||
;*****************************************************
|
||||
|
||||
cseg
|
||||
org 0
|
||||
|
||||
|
||||
ccpm: int ccpmint ! ret
|
||||
|
||||
clock: ; Clock process starts here
|
||||
|
||||
mov ds,sysdat
|
||||
mov dl,.npcons ; dh has # of phy. consoles
|
||||
mov si,.rlr ! mov es,p_uda[si] ; ES is never saved.
|
||||
; Note if other ccpm system calls
|
||||
; are added to this program, ES
|
||||
; may be changed.
|
||||
; mov bx,tod_offset
|
||||
|
||||
; Loop forever
|
||||
clockloop:
|
||||
; BX -> TOD structure in SYSDAT
|
||||
; Wait for Seconds Flag
|
||||
; push bx
|
||||
push dx
|
||||
mov cx,dev_flagwait ! mov dx,sec_flag
|
||||
call ccpm
|
||||
pop dx
|
||||
|
||||
; Call XIOS status line update.
|
||||
; ES=UDA, DS=system data segment
|
||||
; For MCCP/M need to update all physical consoles
|
||||
; This will be done one per second
|
||||
mov ax,io_statline
|
||||
;
|
||||
; xor cx,cx ! mov dx,cx
|
||||
xor cx,cx
|
||||
cmp dl,0
|
||||
jnz still_more
|
||||
mov dl,.npcons ; restart count down
|
||||
still_more:
|
||||
dec dl
|
||||
push dx
|
||||
callf dword ptr .xiosentry
|
||||
pop dx
|
||||
; pop bx
|
||||
mov bx,tod_offset
|
||||
|
||||
; increment seconds
|
||||
clc
|
||||
mov al,tod_sec[bx]
|
||||
inc al ! daa ! mov tod_sec[bx],al
|
||||
|
||||
; check for minute mark
|
||||
|
||||
cmp al,60h ! jae update_min
|
||||
jmp clock_loop
|
||||
|
||||
update_min:
|
||||
; set minute flag
|
||||
|
||||
mov tod_sec[bx],0
|
||||
; mov cx,dev_flagset ! mov dx,min_flag
|
||||
; push bx ! call ccpm ! pop bx
|
||||
|
||||
; increment minute field of TOD
|
||||
|
||||
clc ! mov al,tod_min[bx]
|
||||
inc al ! daa ! mov tod_min[bx],al
|
||||
|
||||
; check if hour
|
||||
|
||||
cmp al,60h ! jae update_hour
|
||||
jmp clock_loop
|
||||
|
||||
update_hour:
|
||||
;update hour field
|
||||
|
||||
mov tod_min[bx],0
|
||||
clc ! mov al,tod_hour[bx]
|
||||
inc al ! daa ! mov tod_hour[bx],al
|
||||
|
||||
; check for day
|
||||
|
||||
cmp al,24h ! jae update_day
|
||||
jmp clock_loop
|
||||
|
||||
update_day:
|
||||
; update Day field
|
||||
|
||||
|
||||
mov tod_hour[bx],0
|
||||
inc tod_day[bx]
|
||||
jmp clock_loop ; loop forever
|
||||
|
||||
;*****************************************************
|
||||
;*
|
||||
;* Data Segment
|
||||
;*
|
||||
;*****************************************************
|
||||
|
||||
dseg
|
||||
org 0
|
||||
|
||||
sysdat dw 0,0,0
|
||||
dw 0,0,0
|
||||
dw 0,0
|
||||
|
||||
org rsp_pd
|
||||
|
||||
dw 0,0 ; link,thread
|
||||
db ps_run ; status
|
||||
db 190 ; priority
|
||||
dw pf_keep ; flags
|
||||
db 'CLOCK ' ; name
|
||||
dw offset uda/10h ; uda seg
|
||||
db 0,0,0,0 ; dsk,usr,ldsk,luser
|
||||
dw 0 ; mem partitions
|
||||
dw 0,0 ; dvract,wait
|
||||
db 0,0 ; org,net
|
||||
dw 0 ; parent
|
||||
db 0,0,0,0 ; cns,abort,cin,cout
|
||||
db 0,0,0,0 ; lst,sf3,sf4,sf5
|
||||
dw 0,0,0,0 ; reserved,pret,scratch
|
||||
|
||||
org rsp_uda
|
||||
|
||||
uda dw 0,0,0,0 ;0-7 note: no default DMA
|
||||
dw 0,0,0,0 ;8-fh
|
||||
dw 0,0,0,0 ;10-17
|
||||
dw 0,0,0,0 ;18-1f
|
||||
dw 0,0,0,0 ;20-27
|
||||
dw 0,0,0,0 ;28-2f
|
||||
dw 0,0,offset stack_top,0 ;30-37
|
||||
dw 0,0,0,0 ;38-3f
|
||||
dw 0,0,0,0 ;40-47
|
||||
dw 0,0,0,0 ;48-4f
|
||||
dw 0,0,0,0 ;50-57
|
||||
dw 0,0,0,0 ;58-5f
|
||||
db 1 ;60 INSYS <> 0
|
||||
;don't switch from
|
||||
;from UDA stack
|
||||
;on entry to SUP
|
||||
db 0
|
||||
|
||||
dw 0cccch,0cccch,0cccch ;62-67
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;68-6F
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;70
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;80
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;90
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;A0
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;B0
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;C0
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;D0
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;E0
|
||||
dw 0cccch,0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;F0
|
||||
dw 0cccch
|
||||
|
||||
stack_top dw offset clock ; code starting point
|
||||
dw 0 ; code seg - set by GENSYS
|
||||
dw 0 ; init. flags - set by GENSYS
|
||||
|
||||
; UDA is 100H bytes long
|
||||
end
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,18 @@
|
||||
|
||||
declare
|
||||
lit literally 'literally',
|
||||
dcl lit 'declare',
|
||||
true lit '0ffh',
|
||||
false lit '0',
|
||||
no lit 'not',
|
||||
boolean lit 'byte',
|
||||
forever lit 'while true',
|
||||
cr lit '13',
|
||||
lf lit '10',
|
||||
tab lit '9',
|
||||
ctrlc lit '3',
|
||||
ff lit '12',
|
||||
page$len$offset lit '1ch',
|
||||
nopage$mode$offset lit '2Ch',
|
||||
sectorlen lit '128';
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
|
||||
/*
|
||||
Copyright (C) 1983
|
||||
Digital Research
|
||||
P.O. Box 579
|
||||
Pacific Grove, CA 93950
|
||||
*/
|
||||
|
||||
|
||||
@@ -0,0 +1,679 @@
|
||||
; Direct CP/M Calls From PL/I-86
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;* cp/m calls from pl/i for direct i/o *
|
||||
;* *
|
||||
;***********************************************************
|
||||
|
||||
cseg
|
||||
|
||||
public memptr ;return pointer to base of free mem
|
||||
public memsiz ;return size of memory in bytes
|
||||
public memwds ;return size of memory in words
|
||||
public dfcb0 ;return address of default fcb 0
|
||||
public dfcb1 ;return address of default fcb 1
|
||||
public dbuff ;return address of default buffer
|
||||
public reboot ;system reboot (#0)
|
||||
public rdcon ;read console character (#1)
|
||||
public wrcon ;write console character(#2)
|
||||
public rdrdr ;read reader character (#3)
|
||||
public wrpun ;write punch character (#4)
|
||||
public wrlst ;write list character (#5)
|
||||
public coninp ;direct console input (#6a)
|
||||
public conout ;direct console output (#6b)
|
||||
public rdstat ;read console status (#6c)
|
||||
public getio ;get io byte (#8)
|
||||
public setio ;set i/o byte (#9)
|
||||
public wrstr ;write string (#10)
|
||||
public rdbuf ;read console buffer (#10)
|
||||
public break ;get console status (#11)
|
||||
public vers ;get version number (#12)
|
||||
public reset ;reset disk system (#13)
|
||||
public select ;select disk (#14)
|
||||
public open ;open file (#15)
|
||||
public close ;close file (#16)
|
||||
public sear ;search for file (#17)
|
||||
public searn ;search for next (#18)
|
||||
public delete ;delete file (#19)
|
||||
public rdseq ;read file sequential mode (#20)
|
||||
public wrseq ;write file sequential mode (#21)
|
||||
public make ;create file (#22)
|
||||
public rename ;rename file (#23)
|
||||
public logvec ;return login vector (#24)
|
||||
public curdsk ;return current disk number (#25)
|
||||
public setdma ;set DMA address (#26)
|
||||
public allvec ;return address of alloc vector (#27)
|
||||
public wpdisk ;write protect disk (#28)
|
||||
public rovec ;return read/only vector (#29)
|
||||
public filatt ;set file attributes (#30)
|
||||
public getdpb ;get base of disk parm block (#31)
|
||||
public getusr ;get user code (#32a)
|
||||
public setusr ;set user code (#32b)
|
||||
public rdran ;read random (#33)
|
||||
public wrran ;write random (#34)
|
||||
public filsiz ;random file size (#35)
|
||||
public setrec ;set random record pos (#36)
|
||||
public resdrv ;reset drive (#37)
|
||||
public wrranz ;write random, zero fill (#40)
|
||||
public movgtl ;move from arbitrary addr to local area
|
||||
public movltg ;move from local area to arbitrary addr
|
||||
public movgtg ;move from arbitrary addr to arbitrary location
|
||||
|
||||
extrn ?begin:word ;beginning of free list
|
||||
extrn ?bdos:near ;bdos entry point
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;* equates for interface to cp/m bdos *
|
||||
;* *
|
||||
;***********************************************************
|
||||
|
||||
cr equ 0dh ;carriage return
|
||||
lf equ 0ah ;line feed
|
||||
eof equ 1ah ;end of file
|
||||
|
||||
readc equ 1 ;read character from console
|
||||
writc equ 2 ;write console character
|
||||
rdrf equ 3 ;reader input
|
||||
punf equ 4 ;punch output
|
||||
listf equ 5 ;list output function
|
||||
diof equ 6 ;direct i/o, version 2.0
|
||||
getiof equ 7 ;get i/o byte
|
||||
setiof equ 8 ;set i/o byte
|
||||
printf equ 9 ;print string function
|
||||
rdconf equ 10 ;read console buffer
|
||||
statf equ 11 ;return console status
|
||||
versf equ 12 ;get version number
|
||||
resetf equ 13 ;system reset
|
||||
seldf equ 14 ;select disk function
|
||||
openf equ 15 ;open file function
|
||||
closef equ 16 ;close file
|
||||
serchf equ 17 ;search for file
|
||||
serchn equ 18 ;search next
|
||||
deletf equ 19 ;delete file
|
||||
readf equ 20 ;read next record
|
||||
writf equ 21 ;write next record
|
||||
makef equ 22 ;make file
|
||||
renamf equ 23 ;rename file
|
||||
loginf equ 24 ;get login vector
|
||||
cdiskf equ 25 ;get current disk number
|
||||
setdmf equ 26 ;set dma function
|
||||
getalf equ 27 ;get allocation base
|
||||
wrprof equ 28 ;write protect disk
|
||||
getrof equ 29 ;get r/o vector
|
||||
setatf equ 30 ;set file attributes
|
||||
getdpf equ 31 ;get disk parameter block
|
||||
userf equ 32 ;set/get user code
|
||||
rdranf equ 33 ;read random
|
||||
wrranf equ 34 ;write random
|
||||
filszf equ 35 ;compute file size
|
||||
setrcf equ 36 ;set random record position
|
||||
rsdrvf equ 37 ;reset drive function
|
||||
wrrnzf equ 40 ;write random zero fill
|
||||
|
||||
; utility functions
|
||||
;***********************************************************
|
||||
;* *
|
||||
;* general purpose routines used upon entry *
|
||||
;* *
|
||||
;***********************************************************
|
||||
|
||||
getp1: ;get single byte parameter to register DL
|
||||
mov bx,[bx] ;BX = .char
|
||||
mov dl,[bx] ;to register DL
|
||||
ret
|
||||
|
||||
getp2: ;get single word value to DX
|
||||
getp2i: ;(equivalent to getp2)
|
||||
mov bx,[bx]
|
||||
mov dx,[bx]
|
||||
ret
|
||||
|
||||
getver: ;get cp/m or mp/m version number
|
||||
push bx ;save possible data addr
|
||||
mov cl,versf
|
||||
call ?bdos
|
||||
pop bx ;recall data addr
|
||||
ret
|
||||
|
||||
chkv20: ;check for version 2.0 or greater
|
||||
call getver
|
||||
cmp al,20h
|
||||
jb vererr ;version error
|
||||
ret ;return if > 2.0
|
||||
|
||||
chkv22: ;check for version 2.2 or greater
|
||||
call getver
|
||||
cmp al,22h
|
||||
jb vererr ;error if < 2.2
|
||||
ret
|
||||
vererr:
|
||||
;version error, report and terminate
|
||||
mov dx,offset vermsg
|
||||
mov cl,printf
|
||||
call ?bdos ;write message
|
||||
jmp reboot ;and reboot
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
memptr: ;return pointer to base of free storage
|
||||
mov bx,?begin
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
memsiz: ;return size of free memory in bytes
|
||||
mov bx,word ptr .6 ;top of available memory
|
||||
sub bx,?begin ;subtract beginning of free storage
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
memwds: ;return size of free memory in words
|
||||
call memsiz ;BX = size in bytes
|
||||
shr bx,1 ;BX = size in words
|
||||
ret ;with words in BX
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
dfcb0: ;return address of default fcb 0
|
||||
mov bx,5ch
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
dfcb1: ;return address of default fcb 1
|
||||
mov bx,6ch
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
dbuff: ;return address of default buffer
|
||||
mov bx,80h
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
reboot: ;system reboot (#0)
|
||||
xor cl,cl ;Reboot code.
|
||||
; mov dl,cl ;Abort code (00h in this case)
|
||||
; ; if needed.
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdcon: ;read console character (#1)
|
||||
;return character value to stack
|
||||
mov cl,readc
|
||||
jmps chrin ;common code to read char
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrcon: ;write console character(#2)
|
||||
;1->char(1)
|
||||
mov cl,writc ;console write function
|
||||
jmps chrout ;to write the character
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdrdr: ;read reader character (#3)
|
||||
mov cl,rdrf ;reader function
|
||||
chrin:
|
||||
;common code for character input
|
||||
call ?bdos ;value returned to AL
|
||||
pop bx ;return address
|
||||
mov ah,al ;char to AH
|
||||
push ax ;character to stack
|
||||
inc sp ;delete garbage byte
|
||||
mov al,1 ;character length is 1
|
||||
jmp bx ;back to calling routine
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrpun: ;write punch character (#4)
|
||||
;1->char(1)
|
||||
mov cl,punf ;punch output function
|
||||
jmps chrout ;common code to write chr
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrlst: ;write list character (#5)
|
||||
;1->char(1)
|
||||
mov cl,listf ;list output function
|
||||
chrout:
|
||||
;common code to write character
|
||||
;1-> character to write
|
||||
call getp1 ;output char to register DL
|
||||
jmp ?bdos ;to write and return
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
coninp: ;perform console input, char returned in stack (#6a)
|
||||
call rdstat ;Keep testing status
|
||||
test al,al ; until char is ready.
|
||||
jz coninp
|
||||
mov cl,diof
|
||||
mov dl,0ffh
|
||||
jmps chrin
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
conout: ;direct console output (#6c)
|
||||
;1->char(1)
|
||||
call getp1 ;get parameter
|
||||
mov cl,diof ;direct console I/O
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdstat: ;direct console status read (#6b)
|
||||
mov dl,0feh
|
||||
mov cl,diof
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
getio: ;get io byte (#7)
|
||||
mov cl,getiof
|
||||
jmp ?bdos ;value returned to AL
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
setio: ;set i/o byte (#8)
|
||||
;1->i/o byte
|
||||
call getp1 ;new i/o byte to DL
|
||||
mov cl,setiof
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrstr: ;write string (#9)
|
||||
;1->addr(string)
|
||||
call getp2 ;get parameter value to DX
|
||||
mov cl,printf ;print string function
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdbuf: ;read console buffer (#10)
|
||||
;1->addr(buff)
|
||||
call getp2i ;DX = .buff
|
||||
mov cl,rdconf ;read console function
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
break: ;get console status (#11)
|
||||
mov cl,statf
|
||||
call ?bdos ;return through bdos
|
||||
add al,0ffh ;return clean true or false values
|
||||
sbb al,al ;AL = 0 or 0ffh
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
vers: ;get version number (#12)
|
||||
mov cl,versf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
reset: ;reset disk system (#13)
|
||||
mov cl,resetf
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
select: ;select disk (#14)
|
||||
;1->fixed(7) drive number
|
||||
call getp1 ;disk number to DL
|
||||
mov cl,seldf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
open: ;open file (#15)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;fcb address to DX
|
||||
mov cl,openf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
close: ;close file (#16)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,closef
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
sear: ;search for file (#17)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,serchf
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
searn: ;search for next (#18)
|
||||
mov cl,serchn ;search next function
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
delete: ;delete file (#19)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,deletf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdseq: ;read file sequential mode (#20)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,readf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrseq: ;write file sequential mode (#21)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,writf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
make: ;create file (#22)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,makef
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rename: ;rename file (#23)
|
||||
;1-> addr(fcb)
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,renamf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
logvec: ;return login vector (#24)
|
||||
mov cl,loginf
|
||||
jmp ?bdos ;return through BDOS
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
curdsk: ;return current disk number (#25)
|
||||
mov cl,cdiskf
|
||||
jmp ?bdos ;return value in AL
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
setdma: ;set DMA address (#26)
|
||||
;1-> pointer (dma address)
|
||||
call getp2 ;dma address to DX
|
||||
mov cl,setdmf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
allvec: ;return address of allocation vector (#27)
|
||||
;Place offset and segment in first two word-length
|
||||
; elements of array passed as a parameter.
|
||||
mov cl,getalf ;Select function.
|
||||
bxes:
|
||||
push es ;Free ES to receive segment base.
|
||||
push word ptr [bx] ;Save parameter.
|
||||
int 0E0h ;Go get values in BX & ES.
|
||||
pop si ;Index parameter via SI.
|
||||
mov [si],bx ;Set up return values.
|
||||
mov 2[si],es
|
||||
pop es ;Restore original setting.
|
||||
ret
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wpdisk: ;write protect disk (#28)
|
||||
call chkv20 ;must be 2.0 or greater
|
||||
mov cl,wrprof
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rovec: ;return read/only vector (#29)
|
||||
call chkv20 ;must be 2.0 or greater
|
||||
mov cl,getrof
|
||||
jmp ?bdos ;value returned in BX
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
filatt: ;set file attributes (#30)
|
||||
;1-> addr(fcb)
|
||||
call chkv20 ;must be 2.0 or greater
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,setatf
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
getdpb: ;get base of current disk parm block (#31)
|
||||
;Place offset and segment in first two word-length
|
||||
; elements of array passed as a parameter.
|
||||
call chkv20 ;check for 2.0 or greater
|
||||
mov cl,getdpf
|
||||
jmps bxes ;Go get values in BX & ES.
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
getusr: ;get user code to register AL
|
||||
call chkv20 ;check for 2.0 or greater
|
||||
mov dl,0ffh ;to get user code
|
||||
mov cl,userf
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
setusr: ;set user code
|
||||
call chkv20 ;check for 2.0 or greater
|
||||
call getp1 ;code to DL
|
||||
mov cl,userf
|
||||
jmp ?bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
rdran: ;read random (#33)
|
||||
;1-> addr(fcb)
|
||||
call chkv20 ;check for 2.0 or greater
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,rdranf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrran: ;write random (#34)
|
||||
;1-> addr(fcb)
|
||||
call chkv20 ;check for 2.0 or greater
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,wrranf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
filsiz: ;compute file size (#35)
|
||||
call chkv20 ;must be 2.0 or greater
|
||||
call getp2 ;.fcb to DX
|
||||
mov cl,filszf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
setrec: ;set random record position (#36)
|
||||
call chkv20 ;must be 2.0 or greater
|
||||
call getp2 ;.fcb to DX
|
||||
mov cl,setrcf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
resdrv: ;reset drive function (#37)
|
||||
;1->drive vector - bit(16)
|
||||
call chkv22 ;must be 2.2 or greater
|
||||
call getp2 ;drive reset vector to DX
|
||||
mov cl,rsdrvf
|
||||
jmp ?bdos ;return through bdos
|
||||
|
||||
;***********************************************************
|
||||
;* *
|
||||
;***********************************************************
|
||||
wrranz: ;write random, zero fill function (#40)
|
||||
;1-> addr(fcb)
|
||||
call chkv22 ;must be 2.2 or greater
|
||||
call getp2i ;.fcb to DX
|
||||
mov cl,wrrnzf
|
||||
jmp ?bdos
|
||||
|
||||
;****************************************************************
|
||||
;* *
|
||||
;* MOVGTL: Move string with global addr to local area *
|
||||
;* MOVLTG: Move string with local addr to global addr *
|
||||
;* MOVGTG: Move string with global addr to global addr *
|
||||
;* *
|
||||
;* These routines are needed to make effective use of ALLVEC *
|
||||
;* and GETDPB. *
|
||||
;* *
|
||||
;* First parameter is length in bytes of string to be moved *
|
||||
;* and is FIXED BINARY(15). *
|
||||
;* Second parameter is source string. *
|
||||
;* Third parameter is target addr. *
|
||||
;* *
|
||||
;* A global addr is passed as a two-element array of pointers; *
|
||||
;* first element is offset; second element is segment. *
|
||||
;* (This is the type of addr returned by ALLVEC and GETDPB.) *
|
||||
;* *
|
||||
;* A local addr is passed as a scalar pointer. *
|
||||
;* *
|
||||
;****************************************************************
|
||||
movgtl: ;Move string with arbitrary addr to local area.
|
||||
mov si,2[bx] ;Retrieve source.
|
||||
push word ptr 2[si] ;Stack segment(source).
|
||||
push word ptr [si] ;Stack offset(source).
|
||||
mov di,4[bx] ;Retrieve destination.
|
||||
push ds ;Stack segment(destination).
|
||||
jmps moov
|
||||
|
||||
movltg: ;Move string in local area to arbitrary addr.
|
||||
mov si,2[bx] ;Retrieve source.
|
||||
push ds ;Stack segment(source).
|
||||
jmps threst
|
||||
|
||||
movgtg: ;Move string with arbitrary addr to arbitrary location.
|
||||
mov si,2[bx] ;Retrieve source.
|
||||
push word ptr 2[si] ;Stack segment(source).
|
||||
threst:
|
||||
push word ptr [si] ;Stack offset(source).
|
||||
mov di,4[bx] ;Retrieve destination.
|
||||
push word ptr 2[di] ;Stack segment(destination).
|
||||
moov:
|
||||
mov ax,[di] ;Retrieve offset(destination).
|
||||
mov cx,16 ;Keep divisor of 16 handy.
|
||||
xor dx,dx ;Prepare for word division.
|
||||
div cx ;Compute adjustment to segment & offset.
|
||||
mov di,dx ;DI := new destination offset.
|
||||
pop bp ;BP := new destination segment.
|
||||
add bp,ax
|
||||
pop ax ;Restore offset(source).
|
||||
xor dx,dx ;Compute adjustment to segment & offset
|
||||
div cx ; of source.
|
||||
mov si,dx ;SI := new source offset.
|
||||
pop dx ;Restore segment(source).
|
||||
push es ;Save original ES.
|
||||
xchg ax,bp ;BP := adjustment to source segment.
|
||||
mov es,ax ;ES := new destination segment.
|
||||
mov bx,[bx] ;Retrieve length.
|
||||
mov cx,[bx]
|
||||
push ds ;Save original DS.
|
||||
xor bx,bx ;Initialize adjustment for word move.
|
||||
add dx,bp ;DS := new source segment.
|
||||
mov ds,dx
|
||||
cmp dx,ax ;CMP source segment, destination segment.
|
||||
jne gnown ;If source precedes destination
|
||||
cmp si,di ; in memory,
|
||||
gnown:
|
||||
jnb ortho ; then will perform backward move,
|
||||
std ; otherwise
|
||||
add si,cx ; will perform forward move.
|
||||
dec si
|
||||
add di,cx
|
||||
dec di
|
||||
inc bx ;Set word move adjustment to 1.
|
||||
ortho:
|
||||
shr cx,1 ;Compute #words to move,
|
||||
jnc grad ; determine if odd byte.
|
||||
movsb ;Move odd byte if any,
|
||||
grad:
|
||||
sub si,bx ; adjust for word move,
|
||||
sub di,bx
|
||||
rep movsw ; then move zero or more words.
|
||||
cld ;Restore direction flag
|
||||
pop ds ; and seg regs.
|
||||
pop es
|
||||
ret
|
||||
|
||||
dseg
|
||||
vermsg db cr,lf,'Later CP/M or MP/M Version Required$'
|
||||
|
||||
end
|
||||
|
||||
@@ -0,0 +1,70 @@
|
||||
|
||||
dcl
|
||||
memptr entry returns (ptr),
|
||||
memsiz entry returns (fixed(15)),
|
||||
memwds entry returns (fixed(15)),
|
||||
dfcb0 entry returns (ptr),
|
||||
dfcb1 entry returns (ptr),
|
||||
dbuff entry returns (ptr),
|
||||
reboot entry,
|
||||
rdcon entry returns (char(1)),
|
||||
wrcon entry (char(1)),
|
||||
rdrdr entry returns (char(1)),
|
||||
wrpun entry (char(1)),
|
||||
wrlst entry (char(1)),
|
||||
coninp entry returns (char(1)),
|
||||
conout entry (char(1)),
|
||||
rdstat entry returns (bit(1)),
|
||||
getio entry returns (bit(8)),
|
||||
setio entry (bit(8)),
|
||||
wrstr entry (ptr),
|
||||
rdbuf entry (ptr),
|
||||
break entry returns (bit(1)),
|
||||
vers entry returns (bit(16)),
|
||||
reset entry,
|
||||
select entry (fixed(7)) returns (bit(16)),
|
||||
open entry (ptr) returns (bit(16)),
|
||||
close entry (ptr) returns (bit(16)),
|
||||
sear entry (ptr) returns (bit(16)),
|
||||
searn entry returns (bit(16)),
|
||||
delete entry (ptr) returns (bit(16)),
|
||||
rdseq entry (ptr) returns (bit(16)),
|
||||
wrseq entry (ptr) returns (bit(16)),
|
||||
make entry (ptr) returns (bit(16)),
|
||||
rename entry (ptr) returns (bit(16)),
|
||||
logvec entry returns (bit(16)),
|
||||
curdsk entry returns (fixed(7)),
|
||||
setdma entry (ptr),
|
||||
allvec entry returns (ptr),
|
||||
wpdisk entry,
|
||||
rovec entry returns (bit(16)),
|
||||
filatt entry (ptr),
|
||||
getdpb entry returns (ptr),
|
||||
getusr entry returns (fixed(7)),
|
||||
setusr entry (fixed(7)),
|
||||
rdran entry (ptr) returns (bit(16)),
|
||||
wrran entry (ptr) returns (bit(16)),
|
||||
filsiz entry (ptr),
|
||||
setrec entry (ptr),
|
||||
resdrv entry (bit(16)) returns (bit(16)),
|
||||
wrranz entry (ptr) returns (bit(16));
|
||||
/**** commented out for CCP/M-86 whf
|
||||
dcl
|
||||
testwr entry (ptr) returns (bit(16)),
|
||||
lock entry (ptr) returns (fixed(7)),
|
||||
unlock entry (ptr) returns (fixed(7)),
|
||||
multis entry (fixed(7)) returns (fixed(7)),
|
||||
ermode entry (bit(1)),
|
||||
freesp entry (fixed(7)) returns (bit(16)),
|
||||
chain entry returns (bit(16)),
|
||||
flush entry returns (fixed(7)),
|
||||
setlbl entry (ptr) returns (bit(16)),
|
||||
getlbl entry (fixed(7)) returns (bit(8)),
|
||||
rdxfcb entry (ptr) returns (bit(16)),
|
||||
wrxfcb entry (ptr) returns (bit(16)),
|
||||
settod entry (ptr),
|
||||
gettod entry (ptr),
|
||||
dfpswd entry (ptr),
|
||||
sgscb entry (ptr) returns(bit(8));
|
||||
****/
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
$TITLE('CONCURRENT CP/M 86 --- DIR 1.0 ')
|
||||
$compact
|
||||
|
||||
/* Conditional compile:
|
||||
rsp=0ffh produce a DIR.RSP type of file
|
||||
rsp=0 produce a DIR.CMD file
|
||||
*/
|
||||
$set(rsp=0h)
|
||||
|
||||
$include(dirm.plm)
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,531 @@
|
||||
/* dirm:
|
||||
This is the module included by DIRRSP or DIRCMD.
|
||||
|
||||
Revised:
|
||||
Jan 80 by Thomas Rolander
|
||||
July 81 by Doug Huskey
|
||||
June 82 by Bill Fitler
|
||||
July 82 by Danny Horovitz (made an RSP)
|
||||
Dec 82 by Fran Borda (conditional comp)
|
||||
Mar 83 by Bill Fitler ( " " )
|
||||
Mar 83 by Danny Horovitz (control C fixes)
|
||||
|
||||
Conditional compile:
|
||||
rsp=0ffh produce a DIR.RSP type of file
|
||||
rsp=0 produce a DIR.CMD file
|
||||
*/
|
||||
|
||||
/**** Vax commands to compile DIR.RSP and DIR.CMD:
|
||||
|
||||
$ ccpmsetup
|
||||
$ plm86 dircmd.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
|
||||
$ link86 f1:scd.obj, dircmd.obj to dircmd.lnk
|
||||
$ loc86 dircmd.lnk od(sm(code,dats,data,stack,const))-
|
||||
ad(sm(code(0), dats(10000h))) ss(stack(+32)) to dircmd.
|
||||
$ h86 dircmd
|
||||
$ ! DIR.RSP
|
||||
$ ! Note: separate code and data
|
||||
$ asm86 rhdir.a86 !Rsp Header DIR
|
||||
$ plm86 dirrsp.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
|
||||
$ link86 rhdir.obj, dirrsp.obj to dirrsp.lnk
|
||||
$ loc86 dirrsp.lnk od(sm(code,dats,data,stack,const))-
|
||||
ad(sm(code(0), dats(10000h))) ss(stack(0)) to dirrsp.
|
||||
$ h86 dirrsp
|
||||
|
||||
**** Then, on a micro:
|
||||
A>vax dircmd.h86 $fans
|
||||
A>vax dirrsp.h86 $fans
|
||||
A>gencmd dircmd data[b1000]
|
||||
A>ren dir.cmd=dircmd.cmd
|
||||
A>gencmd dirrsp data[b1000]
|
||||
A>ren dir.rsp=dirrsp.cmd
|
||||
|
||||
**** Notes: Both DIRCMD.PLM and DIRRSP.PLM include DIRM.PLM, after setting
|
||||
RSP flag appropriately.
|
||||
|
||||
****/
|
||||
|
||||
|
||||
dir:
|
||||
do;
|
||||
|
||||
$include (:f1:copyrt.lit)
|
||||
|
||||
$include (:f1:comlit.lit)
|
||||
|
||||
$include (:f1:mfunc.lit)
|
||||
|
||||
$include (:f1:proces.lit)
|
||||
|
||||
$include (:f1:qd.lit)
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S INTERFACE *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (func,info) address external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon3;
|
||||
|
||||
mon4:
|
||||
procedure (func,info) pointer external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon4;
|
||||
|
||||
|
||||
|
||||
patch: procedure public; /* dummy area for patching code segments */
|
||||
declare i address;
|
||||
/* first statement = 9 bytes, rest are 5 bytes */
|
||||
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
||||
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
||||
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5; /* about 79 bytes */
|
||||
end patch;
|
||||
|
||||
|
||||
$if rsp
|
||||
declare fcb (36) byte; /* 1st default fcb */
|
||||
declare fcb16 (1) byte at (@fcb(16)); /* 2nd default fcb */
|
||||
$else
|
||||
declare fcb (1) byte external; /* 1st default fcb */
|
||||
declare fcb16 (1) byte external; /* 2nd default fcb */
|
||||
$endif
|
||||
|
||||
write$console:
|
||||
procedure (char);
|
||||
declare char byte;
|
||||
call mon1 (2,char);
|
||||
end write$console;
|
||||
|
||||
print$buf:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$buf;
|
||||
|
||||
check$ctrl$c:
|
||||
procedure byte;
|
||||
$if rsp
|
||||
if (dir$pd.flag and pf$ctlC) <> 0 then
|
||||
do;
|
||||
dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
|
||||
return(true);
|
||||
end;
|
||||
$endif
|
||||
return (false);
|
||||
end check$ctrl$c;
|
||||
|
||||
search$first:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (17,fcb$address);
|
||||
end search$first;
|
||||
|
||||
search$next:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (18,fcb$address);
|
||||
end search$next;
|
||||
|
||||
setdma: procedure(dma);
|
||||
declare dma address;
|
||||
call mon1(26,dma);
|
||||
end setdma;
|
||||
|
||||
|
||||
get$user$code:
|
||||
procedure byte;
|
||||
return mon2 (32,0ffh);
|
||||
end get$user$code;
|
||||
|
||||
set$user$code:
|
||||
procedure(user);
|
||||
declare user byte;
|
||||
call mon1 (32,user);
|
||||
end set$user$code;
|
||||
|
||||
terminate:
|
||||
procedure;
|
||||
call mon1 (0,0);
|
||||
end terminate;
|
||||
|
||||
declare
|
||||
parse$fn structure (
|
||||
buff$adr address,
|
||||
fcb$adr address),
|
||||
delimiter based parse$fn.buff$adr byte;
|
||||
declare tail$len address;
|
||||
|
||||
parse: procedure address;
|
||||
return mon3(152,.parse$fn);
|
||||
end parse;
|
||||
|
||||
|
||||
crlf:
|
||||
procedure;
|
||||
call write$console (0dh);
|
||||
call write$console (0ah);
|
||||
end crlf;
|
||||
|
||||
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
|
||||
|
||||
* * * GLOBAL VARIABLES * * *
|
||||
|
||||
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
|
||||
|
||||
declare dir$title (*) byte initial
|
||||
('Directory for User x:','$');
|
||||
|
||||
declare (sys,temp,dcnt,cnt,user) byte;
|
||||
declare
|
||||
i byte,
|
||||
new$user byte,
|
||||
sys$exists byte,
|
||||
incl$sys byte,
|
||||
option byte;
|
||||
|
||||
declare
|
||||
dirbuf (128) byte;
|
||||
|
||||
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
|
||||
|
||||
* * * DIRECTORY DISPLAY * * *
|
||||
|
||||
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
|
||||
/* display directory heading */
|
||||
heading: procedure;
|
||||
|
||||
if user > 9 then
|
||||
do;
|
||||
dir$title(19) = '1';
|
||||
dir$title(20) = user - 10 + '0';
|
||||
end;
|
||||
else
|
||||
do;
|
||||
dir$title(19) = ' ';
|
||||
dir$title(20) = user + '0';
|
||||
end;
|
||||
call print$buf (.dir$title);
|
||||
end heading;
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/*
|
||||
help: procedure;
|
||||
call mon1(m$prt$buf, .(cr, lf, tab, tab, tab ,'DIR EXAMPLES$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, lf, 'dir', tab, tab,
|
||||
'(show all directory files on current drive and user)
|
||||
call mon1(m$prt$buf, .(cr, lf, 'dir [g3]', tab, tab, tab, tab,
|
||||
'(show non system files under user 3)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, 'dir a: b: [s]', tab, tab, tab,
|
||||
tab, '(show all files under current user on a: and b:)$'));
|
||||
call terminate;
|
||||
end help;
|
||||
*/
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* do next directory display */
|
||||
directory: procedure boolean;
|
||||
|
||||
shown$nothing = false;
|
||||
if new$user then do;
|
||||
call heading;
|
||||
new$user = false;
|
||||
end;
|
||||
sys$exists = false;
|
||||
cnt = -1;
|
||||
/* if drive is 0 (default)
|
||||
then set to current disk */
|
||||
if fcb(0) = 0
|
||||
then fcb(0) = mon2 (m$curdsk,0) + 1;
|
||||
if fcb(1) = ' ' then
|
||||
/* check for blank filename => wildcard */
|
||||
do i = 1 to 11;
|
||||
fcb(i) = '?';
|
||||
end;
|
||||
/* get first file */
|
||||
if (dcnt := search$first (.fcb)) <> 0ffh then
|
||||
do while dcnt <> 0ffh;
|
||||
temp = shl(dcnt,5);
|
||||
sys = ((dirbuf(temp+10) and 80h) = 80h);
|
||||
if (dirbuf(temp) = user) and
|
||||
(incl$sys or not sys) then
|
||||
do;
|
||||
if ((cnt:=cnt+1) mod 4) = 0 then
|
||||
do;
|
||||
call crlf;
|
||||
call write$console ('A'+fcb(0)-1);
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call write$console (' ');
|
||||
end;
|
||||
call write$console (':');
|
||||
call write$console (' ');
|
||||
do i = 1 to 11;
|
||||
if i = 9 then call write$console (' ');
|
||||
call write$console
|
||||
(dirbuf(temp+i) and 7fh);
|
||||
if check$ctrl$c then
|
||||
return(false);
|
||||
end;
|
||||
end;
|
||||
else if sys then
|
||||
sys$exists = true;
|
||||
dcnt = search$next (.fcb);
|
||||
end;
|
||||
if cnt = -1 then
|
||||
do;
|
||||
call print$buf (.(0dh,0ah,
|
||||
'File not found.','$'));
|
||||
end;
|
||||
if sys$exists then
|
||||
call print$buf (.(0dh,0ah,
|
||||
'System Files Exist','$'));
|
||||
return(true);
|
||||
end directory;
|
||||
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
|
||||
|
||||
* * * PARSING * * *
|
||||
|
||||
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
|
||||
/* parse one file name, return true if got one */
|
||||
parse$file: procedure boolean;
|
||||
dcl i address;
|
||||
dcl buf based parse$fn.buff$adr (1) byte;
|
||||
dcl parse$ret address;
|
||||
|
||||
if (parse$ret := parse$fn.buff$adr) = 0 then
|
||||
return(false);
|
||||
fcb(0), i = 0;
|
||||
parse$ret = parse; /* kludge around */
|
||||
do while parse$ret = 0 and buf(i) = '['; /* parse file name bugs */
|
||||
if (i := findb(@buf(i), ']', tail$len - i)) <> 0ffffh then
|
||||
do;
|
||||
parse$fn.buff$adr = .buf(i) + 1; /* skip right bracket */
|
||||
i = 0;
|
||||
parse$ret = parse;
|
||||
end;
|
||||
else
|
||||
buf(i) = 0;
|
||||
end;
|
||||
parse$fn.buff$adr = parse$ret;
|
||||
|
||||
|
||||
if parse$fn.buff$adr <> 0ffffh then
|
||||
do;
|
||||
if fcb(1) <> ' ' then
|
||||
do;
|
||||
if parse$fn.buff$adr <> 0 and delimiter <> '[' and delimiter <> 0 then
|
||||
parse$fn.buff$adr = parse$fn.buff$adr + 1;
|
||||
return(true); /* parse$fn.buff$adr could = 0 */
|
||||
end;
|
||||
else if fcb(0) <> 0 and fcb(1) = ' ' then /* drive spec */
|
||||
do;
|
||||
call setb('?', @fcb(1), 11);
|
||||
return(true);
|
||||
end;
|
||||
end;
|
||||
else /* if parse$fn.buff$adr = 0ffffh then */
|
||||
do;
|
||||
call print$buf(.(cr, lf, 'Invalid filespec.$'));
|
||||
shown$nothing = false; /* don't show directory */
|
||||
return(false); /* also if parse$fn.buf$adr = 0 and fcb(0) = ' ' */
|
||||
end;
|
||||
end parse$file;
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* parse & interpret all options - assume global */
|
||||
parse$options: procedure boolean;
|
||||
dcl (n,i) word;
|
||||
dcl (options, in$brackets, error) boolean;
|
||||
i = 0; /* parse file name doesn't work with delimiters */
|
||||
parse$fn.fcb$adr = .dirbuf;
|
||||
error = false;
|
||||
options = true;
|
||||
do while options and not error;
|
||||
if (n := findb(@tbuff(i), '[', tail$len - i)) = 0ffffh then
|
||||
options = false;
|
||||
else
|
||||
do;
|
||||
i = i + n + 1;
|
||||
parse$fn.buff$adr = .tbuff(i);
|
||||
in$brackets = true;
|
||||
do while in$brackets and not error;
|
||||
if (parse$fn.buff$adr := parse) <> 0ffffh then
|
||||
do;
|
||||
if dirbuf(1) = 'S' then
|
||||
incl$sys = true;
|
||||
else if dirbuf(1) = 'G' then
|
||||
do;
|
||||
if dirbuf(3) <> ' ' then
|
||||
temp = dirbuf(3) - '0' + 10;
|
||||
else if dirbuf(2) <> ' ' then
|
||||
temp = dirbuf(2) - '0';
|
||||
if temp < 16 then
|
||||
do;
|
||||
call mon1(m$setusr, (user:=temp));
|
||||
new$user = true;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
error = true;
|
||||
end; /* if parse */
|
||||
if delimiter = ']' or parse$fn.buff$adr = 0 or
|
||||
parse$fn.buff$adr = 0ffffh then
|
||||
in$brackets = false;
|
||||
end; /* while in$brackets */
|
||||
end; /* else */
|
||||
end; /* while options */
|
||||
|
||||
if error then
|
||||
do;
|
||||
call print$buf(.(cr, lf, 'Invalid Command Option$'));
|
||||
return(false);
|
||||
/* call help; */
|
||||
end;
|
||||
return(true);
|
||||
end parse$options;
|
||||
|
||||
|
||||
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
|
||||
|
||||
* * * M A I N P R O G R A M * * *
|
||||
|
||||
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
$if rsp
|
||||
declare cpd$pointer pointer; /* Calling PD pointer stuff */
|
||||
declare cpd$ptr structure (
|
||||
offset address, segment address) at (@cpd$pointer);
|
||||
declare calling$pd based cpd$pointer pd$structure;
|
||||
declare dpd$pointer pointer; /* DIR RSP PD pointer stuff */
|
||||
declare dpd$ptr structure (
|
||||
offset address, segment address) at (@dpd$pointer);
|
||||
declare dir$pd based dpd$pointer pd$structure;
|
||||
declare qdbuf (131) byte;
|
||||
declare dirqd qd$structure initial
|
||||
(0, 0, 0, qf$keep + qf$rsp, 'DIR ', 131, 1, 0, 0, 0, 0, .qdbuf);
|
||||
declare qpbbuf (131) byte;
|
||||
declare cpd$offset address at (@qpbbuf(0));
|
||||
declare tbuff (128) byte at (@qpbbuf(2));
|
||||
declare dirqpb qpb$structure initial
|
||||
(0, 0, 0, 0, .qpbbuf, 'DIR ');
|
||||
$else
|
||||
declare tbuff (128) byte external;
|
||||
$endif
|
||||
|
||||
declare shown$nothing boolean;
|
||||
|
||||
plmstart: procedure public;
|
||||
|
||||
/* initialization */
|
||||
|
||||
$if rsp
|
||||
call mon1(m$make$q, .dirqd);
|
||||
call mon1(m$open$q, .dirqpb);
|
||||
call mon1(m$set$prior, 200); /* Set priority same as other transients*/
|
||||
$else
|
||||
user = get$user$code; /* ????? whf */
|
||||
incl$sys = (fcb(1) = 'S'); /* ????? why exclude if rsp? whf */
|
||||
$endif
|
||||
|
||||
call setdma(.dirbuf);
|
||||
$if rsp
|
||||
cpd$pointer,dpd$pointer = mon4(m$sysdat, 0);
|
||||
dpd$ptr.offset = mon3(m$getpd,0);
|
||||
/* Don't allow control S, turn on tempkeep for control C checking */
|
||||
dir$pd.flag = dir$pd.flag or pf$noctls or pf$tempkeep;
|
||||
/* Read RSP Queue forever */
|
||||
do forever;
|
||||
call mon1(m$readq, .dirqpb);
|
||||
dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
|
||||
/* Could be on from last DIR */
|
||||
/* set defaults same as calling process's, have both PDs so will poke */
|
||||
/* and not call O.S. */
|
||||
cpd$ptr.offset = cpd$offset;
|
||||
call mon1(m$setcns, calling$pd.cns);
|
||||
call mon1(m$setusr, (user := calling$pd.user));
|
||||
call mon1(m$select, calling$pd.dsk);
|
||||
$endif
|
||||
new$user = true;
|
||||
sys$exists, incl$sys = false;
|
||||
tail$len = findb(@tbuff, 0, 128);
|
||||
|
||||
/* scan for options - all are global */
|
||||
|
||||
if not parse$options then
|
||||
goto done; /* option error */
|
||||
|
||||
/* do command line */
|
||||
|
||||
shown$nothing = true;
|
||||
$if rsp
|
||||
parse$fn.buff$adr = .tbuff;
|
||||
$else
|
||||
parse$fn.buff$adr = (.tbuff) + 1;/* Skip # of bytes in buffer */
|
||||
$endif
|
||||
parse$fn.fcb$adr = .fcb;
|
||||
do while parse$file; /* false when no more files, sets */
|
||||
if not directory then /* shown$nothing=false if parsing error */
|
||||
goto done; /* directory = false if console inpute */
|
||||
end;
|
||||
|
||||
if shown$nothing then /* no files specified on command line */
|
||||
do;
|
||||
call setb('?', @fcb(1), 11);
|
||||
if not directory then
|
||||
goto done; /* false on console input */
|
||||
end;
|
||||
done:
|
||||
$if rsp
|
||||
call mon1(m$detach, 0);
|
||||
end; /* do forever */
|
||||
$else
|
||||
call terminate;
|
||||
$endif
|
||||
|
||||
end plmstart;
|
||||
|
||||
end dir;
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
$TITLE('CONCURRENT CP/M 86 --- DIR 1.0 ')
|
||||
$compact
|
||||
|
||||
|
||||
/* Conditional compile:
|
||||
rsp=0ffh produce a DIR.RSP type of file
|
||||
rsp=0 produce a DIR.CMD file
|
||||
*/
|
||||
$set(rsp=0ffh)
|
||||
|
||||
$include(dirm.plm)
|
||||
|
||||
|
||||
@@ -0,0 +1,192 @@
|
||||
|
||||
;
|
||||
; ECHO - Resident System Process
|
||||
; Print Command tail to console
|
||||
;
|
||||
|
||||
;
|
||||
; DEFINITIONS
|
||||
;
|
||||
|
||||
ccpmint equ 224 ;ccpm entry interrupt
|
||||
c_writebuf equ 9 ;print string
|
||||
c_detach equ 147 ;detach console
|
||||
c_setnum equ 148 ;set default console
|
||||
q_make equ 134 ;create queue
|
||||
q_open equ 135 ;open queue
|
||||
q_read equ 137 ;read queue
|
||||
q_write equ 139 ;write queue
|
||||
p_priority equ 145 ;set priority
|
||||
|
||||
pdlen equ 48 ;length of Process
|
||||
; Descriptor
|
||||
|
||||
p_cns equ byte ptr 020h ;default cns
|
||||
p_disk equ byte ptr 012h ;default disk
|
||||
p_user equ byte ptr 013h ;default user
|
||||
p_list equ byte ptr 024h ;default list
|
||||
ps_run equ 0 ;PD run status
|
||||
pf_keep equ 2 ;PD nokill flag
|
||||
|
||||
rsp_top equ 0 ;rsp offset
|
||||
rsp_pd equ 010h ;PD offset
|
||||
rsp_uda equ 040h ;UDA offset
|
||||
rsp_bottom equ 140h ;end rsp header
|
||||
|
||||
qf_rsp equ 08h ;queue RSP flag
|
||||
|
||||
;
|
||||
; CODE SEGMENT
|
||||
;
|
||||
CSEG
|
||||
org 0
|
||||
|
||||
ccpm: int ccpmint
|
||||
ret
|
||||
|
||||
main: ;create ECHO queue
|
||||
mov cl,q_make ! mov dx,offset qd
|
||||
call ccpm
|
||||
;open ECHO queue
|
||||
mov cl,q_open ! mov dx,offset qpb
|
||||
call ccpm
|
||||
;set priority to normal
|
||||
mov cl,p_priority ! mov dx,200
|
||||
call ccpm
|
||||
|
||||
;ES points to SYSDAT
|
||||
mov es,sdatseg
|
||||
|
||||
loop: ;forever
|
||||
;read cmdtail from queue
|
||||
mov cl,q_read ! mov dx,offset qpb
|
||||
call ccpm
|
||||
|
||||
;set default values from PD
|
||||
mov bx,pdadr
|
||||
; mov dl,es:p_disk[bx] ;p_disk=0-15
|
||||
; inc dl ! mov disk,dl ;make disk=1-16
|
||||
; mov dl,es:p_user[bx]
|
||||
; mov user,dl
|
||||
; mov dl,es:p_list[bx]
|
||||
; mov list,dl
|
||||
mov dl,es:p_cns[bx]
|
||||
mov console,dl
|
||||
|
||||
;set default console
|
||||
; mov dl,console
|
||||
mov cl,c_setnum ! call ccpm
|
||||
|
||||
;scan cmdtail and look for '$' or 0.
|
||||
;when found, replace w/ cr,lf,'$'
|
||||
|
||||
lea bx,cmdtail ! mov al,'$' ! mov ah,0
|
||||
mov dx,bx ! add dx,131
|
||||
nextchar:
|
||||
cmp bx,dx ! ja endcmd
|
||||
cmp [bx],al ! je endcmd
|
||||
cmp [bx],ah ! je endcmd
|
||||
inc bx ! jmps nextchar
|
||||
endcmd:
|
||||
mov byte ptr [bx],13
|
||||
mov byte ptr 1[bx],10
|
||||
mov byte ptr 2[bx],'$'
|
||||
|
||||
;write command tail
|
||||
lea dx,cmdtail ! mov cl,c_writebuf
|
||||
call ccpm
|
||||
;detach console
|
||||
mov dl,console
|
||||
mov cl,c_detach ! call ccpm
|
||||
;done, get next command
|
||||
jmps loop
|
||||
|
||||
;
|
||||
; DATA SEGMENT
|
||||
;
|
||||
|
||||
DSEG
|
||||
org rsp_top
|
||||
|
||||
sdatseg dw 0,0,0
|
||||
dw 0,0,0
|
||||
dw 0,0
|
||||
|
||||
org rsp_pd
|
||||
|
||||
pd dw 0,0 ; link,thread
|
||||
db ps_run ; status
|
||||
db 190 ; priority
|
||||
dw pf_keep ; flags
|
||||
db 'ECHO ' ; name
|
||||
dw offset uda/10h ; uda seg
|
||||
db 0,0 ; disk,user
|
||||
db 0,0 ; load dsk,usr
|
||||
dw 0 ; mem
|
||||
dw 0,0 ; dvract,wait
|
||||
db 0,0
|
||||
dw 0
|
||||
db 0 ; console
|
||||
db 0,0,0
|
||||
db 0 ; list
|
||||
db 0,0,0
|
||||
dw 0,0,0,0
|
||||
|
||||
org rsp_uda
|
||||
|
||||
uda dw 0,offset dma,0,0 ;0
|
||||
dw 0,0,0,0
|
||||
dw 0,0,0,0 ;10h
|
||||
dw 0,0,0,0
|
||||
dw 0,0,0,0 ;20h
|
||||
dw 0,0,0,0
|
||||
dw 0,0,offset stack_tos,0 ;30h
|
||||
dw 0,0,0,0
|
||||
dw 0,0,0,0 ;40h
|
||||
dw 0,0,0,0
|
||||
dw 0,0,0,0 ;50h
|
||||
dw 0,0,0,0
|
||||
dw 0,0,0,0 ;60h
|
||||
|
||||
org rsp_bottom
|
||||
|
||||
qbuf rb 131 ;Queue buffer
|
||||
|
||||
qd dw 0 ;link
|
||||
db 0,0 ;net,org
|
||||
dw qf_rsp ;flags
|
||||
db 'ECHO ' ;name
|
||||
dw 131 ;msglen
|
||||
dw 1 ;nmsgs
|
||||
dw 0,0 ;dq,nq
|
||||
dw 0,0 ;msgcnt,msgout
|
||||
dw offset qbuf ;buffer addr.
|
||||
|
||||
dma rb 128
|
||||
|
||||
stack dw 0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch
|
||||
dw 0cccch,0cccch,0cccch
|
||||
stack_tos dw offset main ; start offset
|
||||
dw 0 ; start seg
|
||||
dw 0 ; init flags
|
||||
|
||||
pdadr rw 1 ; QPB Buffer
|
||||
cmdtail rb 129 ; starts here
|
||||
db 13,10,'$'
|
||||
|
||||
qpb db 0,0 ;must be zero
|
||||
dw 0 ;queue ID
|
||||
dw 1 ;nmsgs
|
||||
dw offset pdadr ;buffer addr.
|
||||
db 'ECHO ' ;name to open
|
||||
|
||||
console db 0
|
||||
;disk db 0
|
||||
;user db 0
|
||||
;list db 0
|
||||
|
||||
end
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,8 @@
|
||||
; submit procedure for compiling INITDIR for CCP/M-86 on CCP/M-86
|
||||
pli initdir $dl
|
||||
rasm86 initdira
|
||||
rasm86 diomod
|
||||
link86 initdir [locals],initdira,diomod
|
||||
dir *.sub *.pli *.a86 *.dcl *.lst
|
||||
date
|
||||
|
||||
@@ -0,0 +1,380 @@
|
||||
; **********************************************************************
|
||||
; initdira - Provides BIOS (XIOS) assembler interface for INITDIR.PLI
|
||||
; - Also provides examples of how to:
|
||||
; 1. Call CCP/M-86 XIOS
|
||||
; 2. Lock up disk system for direct disk I/O
|
||||
; 3. Lock up console, to prevent a job from being switched out
|
||||
; **********************************************************************
|
||||
|
||||
|
||||
cseg
|
||||
|
||||
public bstdma ; sets DMA segment and offset
|
||||
public rdsec ; reads a physical sector
|
||||
public sectrn ; translates a sector
|
||||
public seldsk ; selects a drive
|
||||
public setsec ; sets the sector to be read/written
|
||||
public settrk ; sets the track to be read/written
|
||||
public wrsec ; writes a physical sector
|
||||
|
||||
public openvec ; returns open files vector
|
||||
public syslock ; locks up the disk system
|
||||
public sysunlock ; unlocks the disk system
|
||||
public conlock ; locks the console into foreground mode
|
||||
public conunlock ; unclocks the console
|
||||
|
||||
|
||||
IO_SELDSK equ 9 ; XIOS function number
|
||||
IO_READ equ 10 ; XIOS function number
|
||||
IO_WRITE equ 11 ; XIOS function number
|
||||
P_PRIORITY equ 145 ; BDOS function: set Process PRIORITY
|
||||
S_SYSDAT equ 154 ; BDOS function: get SYStem DATa page address
|
||||
P_PDADR equ 156 ; BDOS function: get Process Descriptor address
|
||||
Q_OPEN equ 135 ; Open Queue
|
||||
Q_READC equ 138 ; Read Queue Conditional
|
||||
Q_WRITEC equ 139 ; Write Queue Conditional
|
||||
|
||||
XIOS_ptr equ dword ptr .28h ; loc of XIOS entry in SYSDAT
|
||||
OPVEC equ word ptr .88h ; loc of Open_Files_on_Drives vector
|
||||
UDA_seg equ word ptr 10h ; loc of UDA seg in Process Descriptor
|
||||
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** PL/I Utility Functions ***
|
||||
;*****************************************************************
|
||||
getp1: ; get single byte parameter to register DL
|
||||
mov bx,[bx] ;BX = .char
|
||||
mov dl,[bx] ;to register DL
|
||||
ret
|
||||
|
||||
getp2: ; get single word value to DX
|
||||
getp2i: ; same as getp2
|
||||
mov bx,[bx]
|
||||
mov dx,[bx]
|
||||
ret
|
||||
|
||||
|
||||
getsu: ;get sysdat and uda addrs
|
||||
;enters: DS=local data seg
|
||||
;exits: DS=SYSDAT seg, ES=UDA seg (for call to XIOS)
|
||||
mov cx,udaaddr ;get the saved value
|
||||
or cx,cx ;set flags
|
||||
jz getsu1 ;uninitialized, go do the OS call
|
||||
mov es,cx ;we've been here before, just load regs
|
||||
mov cx,sysaddr
|
||||
mov ds,cx
|
||||
ret
|
||||
|
||||
getsu1:
|
||||
mov cl,P_PDADR ;get Process Descriptor
|
||||
int 0E0h ;call BDOS
|
||||
mov cx,es:UDA_seg[bx] ;grab UDA_seg
|
||||
mov udaaddr,cx ;save for future calls
|
||||
push cx ;save UDA_seg
|
||||
mov cl,S_SYSDAT ;get address of SYStem DATa area
|
||||
int 0E0h ;call BDOS
|
||||
mov cx,es ;mov ds,es
|
||||
mov sysaddr,cx ;save for future calls
|
||||
mov ds,cx
|
||||
pop es ;restore UDA_seg
|
||||
ret
|
||||
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** Simulate old XIOS style functions ***
|
||||
;*****************************************************************
|
||||
bstdma: ; sets DMA segment and offset
|
||||
call getp2 ;dma address to DX
|
||||
mov dmaoff,dx ;stuff addr in IOPB's offset field
|
||||
mov dmaseg,ds ;assume all addresses relative to DS
|
||||
ret ;no BDOS/XIOS call, just init the IOPB
|
||||
|
||||
|
||||
sectrn: ; translates a sector
|
||||
call getp2 ;get sector number to DX
|
||||
mov bx,dx ;no translation: return (unchanged) value
|
||||
ret
|
||||
|
||||
|
||||
setsec: ; sets the sector to be read/written
|
||||
call getp2i ;sector number to DX
|
||||
mov sector,dx ;stuff sector into IOPB
|
||||
ret
|
||||
|
||||
|
||||
settrk: ; sets the track to be read/written
|
||||
call getp2i ;track number to DX
|
||||
mov track,dx ;stuff track into IOPB
|
||||
ret
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** Physical I/O calls ***
|
||||
;*****************************************************************
|
||||
rdsec: ; reads a physical sector
|
||||
mov ax,IO_READ
|
||||
jmp xiosiopb ;jump around this code
|
||||
|
||||
wrsec: ; writes a physical sector
|
||||
mov ax,IO_WRITE ;fall thru to xiosiopb
|
||||
|
||||
xiosiopb: ;put the IOPB on the stack, call XIOS
|
||||
push ds ;ds will contain SYSDAT seg
|
||||
push es ;es will contain UDA seg
|
||||
;someday change this to a block move?
|
||||
mov ch,mscnt
|
||||
mov cl,drv
|
||||
push cx ;1st word of IOPB
|
||||
mov cx,track
|
||||
push cx ;2nd word
|
||||
mov cx,sector
|
||||
push cx ;3rd word
|
||||
mov cx,dmaseg
|
||||
push cx ;4th word
|
||||
mov cx,dmaoff
|
||||
push cx ;5th word
|
||||
|
||||
push ax ;save XIOS_function
|
||||
call getsu ;set up DS-SYSDAT and ES-UDA
|
||||
pop ax ;restore XIOS_function
|
||||
callf XIOS_ptr ;call indirect the XIOS
|
||||
;bl contains return status
|
||||
pop cx ;dma offset
|
||||
pop cx ;dma segment
|
||||
pop cx ;track
|
||||
pop cx ;sector
|
||||
pop cx ;drv & mscnt
|
||||
pop es ;restore original es
|
||||
pop ds ;ditto for ds
|
||||
ret
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** XIOS Select Disk Routine ***
|
||||
;*****************************************************************
|
||||
seldsk: ; selects a drive
|
||||
; also resets login sequence number of drive to 0,
|
||||
; to force permanent media to be logged in again on disk reset
|
||||
|
||||
call getp1 ;drive to DL
|
||||
mov drv,dl ;stuff drive into IOPB
|
||||
push es ! push ds ;save context ************
|
||||
;do the XIOS SELDSK call
|
||||
push dx ;save drive
|
||||
call getsu ;set up DS and ES
|
||||
pop cx ;restore drive
|
||||
mov ax,IO_SELDSK
|
||||
mov dx,0 ;this better not be the first call
|
||||
callf XIOS_ptr ;call indirect XIOS
|
||||
;xfer DPH locally
|
||||
pop es ! push es ;restore & save Data Segment into es
|
||||
mov di,offset dph ;set up destination
|
||||
mov si,bx ;ptr to dph returned from XIOS call
|
||||
mov log_seqn[si],0 ;force disk reset: 0 login sequence number
|
||||
mov cx,dphsiz
|
||||
rep movsb ;move copy of DPH into local storage
|
||||
;xfer DPB locally
|
||||
mov di,offset dpb ;set up destination
|
||||
mov si,es:dpbptr ;get this info from DPH
|
||||
mov cx,dpbsiz
|
||||
rep movsb ;move copy of DPB into local storage
|
||||
;cleanup
|
||||
pop ds ! pop es ;restore context ************
|
||||
mov dpbptr,offset dpb ;set up local ptr in DPH
|
||||
mov bx,offset dph ;return address of local copy of DPH
|
||||
ret
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** Open Drives Vector ***
|
||||
;*****************************************************************
|
||||
openvec: ; returns vector of drives with open files
|
||||
push es ;save extra seg
|
||||
push ds ;save data seg
|
||||
mov cl,S_SYSDAT ;look in the system data page
|
||||
int 0E0h ;call bdos
|
||||
mov ax,es:OPVEC ;get the vector of drives containing open files
|
||||
mov bx,ax ;stuff both regs
|
||||
pop ds ;restore data seg
|
||||
pop es ;restore extra seg
|
||||
ret
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** System Lock and Unlock Routines ***
|
||||
;*****************************************************************
|
||||
syslock: ; locks up the disk system
|
||||
; returns 0 in ax,bx if everything ok, -1 o.w.
|
||||
push es ;save extra seg
|
||||
push ds ;save data seg
|
||||
|
||||
mov cl,S_SYSDAT ;look in the system data page
|
||||
int 0E0h ;call bdos
|
||||
mov cx,es:OPVEC ;get the vector of drives containing open files
|
||||
test cx,0FFFFh ;check all drives
|
||||
jnz syslfail ;fail if any open files
|
||||
|
||||
mov cx,Q_OPEN
|
||||
mov dx,offset qpb ;mxdisk queue parm block
|
||||
int 0E0h ;call bdos
|
||||
or ax,ax ;test return
|
||||
jnz sysltry2 ;if non zero, try kluge
|
||||
mov cx,Q_READC ;see if we can read the queue
|
||||
mov dx,offset qpb ;insurance
|
||||
int 0E0h ;call bdos
|
||||
or ax,ax ;test retrun
|
||||
jnz syslfail ;fail if we can't read mxdisk queue
|
||||
jmp syslokay ;okay, tell 'em so
|
||||
|
||||
sysltry2: ;kluge for old systems
|
||||
mov cx,Q_OPEN
|
||||
mov dx,offset qpb2 ;mxdisk queue parm block
|
||||
int 0E0h ;call bdos
|
||||
or ax,ax ;test return
|
||||
jnz syslfail ;if non zero
|
||||
mov cx,Q_READC ;see if we can read the queue
|
||||
mov dx,offset qpb2 ;insurance
|
||||
int 0E0h ;call bdos
|
||||
or ax,ax ;test retrun
|
||||
jnz syslfail ;fail if we can't read mxdisk queue
|
||||
syslokay:
|
||||
mov ax,0 ! jmp syslret ;return code 0, everything okay
|
||||
syslfail:
|
||||
mov ax,0FFFFh ;return code -1, failure
|
||||
syslret:
|
||||
mov bx,ax ;stuff both regs
|
||||
pop ds ;restore data seg
|
||||
pop es ;restore extra seg
|
||||
ret
|
||||
|
||||
|
||||
|
||||
sysunlock: ;undoes a 'syslock' function
|
||||
mov cx,Q_WRITEC ;conditionally write to mxdisk queue
|
||||
mov dx,offset qpb
|
||||
int 0E0h
|
||||
mov cx,Q_WRITEC ;kluge to handle old systems
|
||||
mov dx,offset qpb2
|
||||
int 0E0h
|
||||
ret
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** Console Lock and Unlock Routines ***
|
||||
;*****************************************************************
|
||||
|
||||
CCB_BACKGRD equ 0002h ;Console in Background mode
|
||||
CCB_NOSWITCH equ 0008h ;Console not allowed to switch mode
|
||||
CCB_SIZE equ 2Ch ;size of CCB
|
||||
CCB_STATE equ word ptr 0Eh ;addr of Console State word in CCB
|
||||
CON_NUM equ byte ptr 020h ;addr of console number in PD
|
||||
CCB_PTR equ word ptr .054h ;addr of CCB table in SYSDAT
|
||||
|
||||
PD_FLAG equ word ptr 06 ;addr of FLAGs word in PD
|
||||
PD_KEEP equ 0002h ;Keep Process Flag
|
||||
TOP_PRIOR equ 151 ;What we set to for Top Priority (arbitrary)
|
||||
REG_PRIOR equ 200 ;Default Regular Priority
|
||||
|
||||
|
||||
conlock: ;locks the console into the foreground, sets Keep Flag,
|
||||
; and boosts priority
|
||||
;returns 0 in ax,dx if everything okay, -1 o.w.
|
||||
push es ;save extra seg
|
||||
call concalc ;ES=SYSDAT, bx=CCB offset
|
||||
test es:CCB_STATE[bx],CCB_BACKGRD ;is console in background?
|
||||
jnz conlfail ;background operation not allowed!
|
||||
or es:CCB_STATE[bx],CCB_NOSWITCH ;make sure they don't switch
|
||||
mov cl,P_PDADR ;get Process Descriptor
|
||||
int 0E0h ;call BDOS
|
||||
or es:PD_FLAG[bx],PD_KEEP ;set Keep flag
|
||||
mov dl,TOP_PRIOR ;let's be quick
|
||||
mov cl,P_PRIORITY ;set Priority
|
||||
int 0E0h ;call BDOS
|
||||
|
||||
conlokay:
|
||||
mov ax,0 ! jmp conlret
|
||||
conlfail:
|
||||
mov ax,0FFFFh
|
||||
conlret:
|
||||
mov bx,ax
|
||||
pop es ;restore extra seg
|
||||
ret
|
||||
|
||||
|
||||
|
||||
conunlock: ;undoes the 'conlock' function
|
||||
push es ;save extra seg
|
||||
call concalc ;ES=sysdat, bx=CCB offset
|
||||
and es:CCB_STATE[bx],NOT CCB_NOSWITCH ;let them switch now
|
||||
mov cl,P_PDADR ;get Process Descriptor
|
||||
int 0E0h ;call BDOS
|
||||
and es:PD_FLAG[bx],NOT PD_KEEP ;reset Keep flag
|
||||
mov dl,REG_PRIOR ;finished with quick
|
||||
mov cl,P_PRIORITY ;set Priority
|
||||
int 0E0h ;call BDOS
|
||||
|
||||
pop es ;restore extra seg
|
||||
ret
|
||||
|
||||
|
||||
|
||||
concalc: ;put SYSDAT in ES, offset of CCB in bx
|
||||
mov cx,P_PDADR ;get Process Descriptor Addr
|
||||
int 0E0h ;call the bdos
|
||||
xor ax,ax ;clear ax
|
||||
mov al,es:CON_NUM[bx] ;grab the console number
|
||||
mov cx,CCB_SIZE ;stuff cx with size
|
||||
mul cx ;compute ccb address
|
||||
push ax ;save ccb offset
|
||||
mov cl,S_SYSDAT ;get the System Data Segment
|
||||
int 0E0h ;call the bdos
|
||||
pop bx ;restore ccb offset
|
||||
add bx,es:CCB_PTR ;compute offset of ccb
|
||||
ret
|
||||
|
||||
|
||||
|
||||
;*****************************************************************
|
||||
;*** Data Segment ***
|
||||
;*****************************************************************
|
||||
|
||||
dseg
|
||||
|
||||
sysaddr dw 0 ; save location for sysdat addr
|
||||
udaaddr dw 0 ; save location for process uda addr
|
||||
|
||||
dphsiz equ 014h ; size of Disk Parm Header
|
||||
dph rb dphsiz ; local save area
|
||||
log_seqn equ byte ptr 6 ; byte to force reset of permanent media
|
||||
dpbptr equ word ptr dph+8 ; word of interest: DPB offset
|
||||
|
||||
dpbsiz equ 011h ; size of Disk Parameter Buffer
|
||||
dpb rb dpbsiz ; local save area
|
||||
|
||||
|
||||
iopb rb 0 ; the iopb structure filled in by above rtns
|
||||
mscnt db 1 ; multi sector count
|
||||
drv rb 1 ; select drive
|
||||
track rw 1 ; select track
|
||||
sector rw 1 ; select sector
|
||||
dmaseg rw 1 ; set dma address
|
||||
dmaoff rw 1 ; set dma address
|
||||
iopbsiz equ (offset $)-(offset iopb)
|
||||
|
||||
|
||||
qpb rb 0 ; queue parameter block
|
||||
dw 0 ; reserved
|
||||
dw 0 ; queueid
|
||||
dw 0 ; nmsgs
|
||||
dw 0 ; buffer
|
||||
db 'MXdisk ' ; queue name
|
||||
|
||||
qpb2 rb 0 ; queue parameter block number 2: be persistent
|
||||
dw 0 ; reserved
|
||||
dw 0 ; queueid
|
||||
dw 0 ; nmsgs
|
||||
dw 0 ; buffer
|
||||
db 'mxdisk ' ; queue name
|
||||
|
||||
@@ -0,0 +1,17 @@
|
||||
|
||||
declare
|
||||
seldsk entry (fixed(7)) returns(ptr),
|
||||
settrk entry (fixed(15)),
|
||||
setsec entry (fixed(15)),
|
||||
rdsec entry returns(fixed(7)),
|
||||
wrsec entry (fixed(7)) returns(fixed(7)),
|
||||
sectrn entry (fixed(15), ptr) returns(fixed(15)),
|
||||
bstdma entry (ptr);
|
||||
|
||||
declare /* CCPM special functions whf 1/14/82 */
|
||||
openvec entry returns(fixed(15)),
|
||||
syslock entry returns(fixed(7)),
|
||||
sysunlock entry,
|
||||
conlock entry returns(fixed(7)),
|
||||
conunlock entry;
|
||||
|
||||
@@ -0,0 +1,47 @@
|
||||
name inpout
|
||||
;
|
||||
; CP/M-86 1.1 PIP Utility INP: / OUT:
|
||||
; Interface module with separate code and data
|
||||
; Code org'd at 080h
|
||||
; December 18, 1981
|
||||
|
||||
cgroup group code
|
||||
|
||||
assume cs:cgroup
|
||||
|
||||
code segment public 'CODE'
|
||||
public inploc,outloc,inpd,outd
|
||||
|
||||
org 00h ; for separate code and data
|
||||
inpd proc
|
||||
push bp
|
||||
call inploc
|
||||
pop bp
|
||||
ret
|
||||
inpd endp
|
||||
|
||||
outd proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov al,[bp]+4
|
||||
call outloc
|
||||
pop bp
|
||||
ret 2
|
||||
outd endp
|
||||
|
||||
inploc proc
|
||||
mov al,01Ah
|
||||
ret
|
||||
inploc endp
|
||||
|
||||
outloc proc
|
||||
ret
|
||||
nop
|
||||
nop
|
||||
outloc endp
|
||||
|
||||
org 07fh
|
||||
db 0
|
||||
code ends
|
||||
end
|
||||
|
||||
@@ -0,0 +1,46 @@
|
||||
|
||||
/* Concurrent CP/M function numbers */
|
||||
|
||||
dcl m$prtbuf lit '9',
|
||||
m$select lit '14',
|
||||
m$openf lit '15',
|
||||
m$closef lit '16',
|
||||
m$deletef lit '19',
|
||||
m$readf lit '20',
|
||||
m$writef lit '21',
|
||||
m$makef lit '22',
|
||||
m$getlogin lit '24',
|
||||
m$curdsk lit '25',
|
||||
m$setdma lit '26',
|
||||
m$setatt lit '30',
|
||||
m$setusr lit '32',
|
||||
m$readrf lit '33',
|
||||
m$writerf lit '34',
|
||||
m$resetdrv lit '37',
|
||||
m$errmode lit '45',
|
||||
m$dirbios lit '50',
|
||||
m$makeq lit '134',
|
||||
m$openq lit '135',
|
||||
m$deleteq lit '136',
|
||||
m$readq lit '137',
|
||||
m$creadq lit '138',
|
||||
m$writeq lit '139',
|
||||
m$cwriteq lit '140',
|
||||
m$delay lit '141',
|
||||
m$dispatch lit '142',
|
||||
m$setprior lit '145',
|
||||
m$attach lit '146',
|
||||
m$detach lit '147',
|
||||
m$setcns lit '148',
|
||||
m$parse lit '152',
|
||||
m$getcns lit '153',
|
||||
m$sysdat lit '154',
|
||||
m$getpd lit '156',
|
||||
m$abort lit '157';
|
||||
|
||||
/* Internal calls */
|
||||
|
||||
dcl mi$sleep lit '0212H',
|
||||
mi$wakeup lit '0213H';
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,49 @@
|
||||
|
||||
/*
|
||||
Proces Literals MP/M-8086 II
|
||||
*/
|
||||
|
||||
declare pnamsiz literally '8';
|
||||
|
||||
declare pd$hdr literally 'structure
|
||||
(link word,thread word,stat byte,prior byte,flag word,
|
||||
name (8) byte,uda word,dsk byte,user byte,ldsk byte,luser byte,
|
||||
mem word';
|
||||
|
||||
declare pd$structure literally 'pd$hdr,
|
||||
dvract word,wait word,org byte,net byte,parent word,
|
||||
cns byte,abort byte,conmode word,lst byte,sf3 byte,sf4 byte,sf5 byte,
|
||||
reservd (4) byte,pret word,scratch word)';
|
||||
|
||||
declare psrun lit '00',
|
||||
pspoll lit '01',
|
||||
psdelay lit '02',
|
||||
psswap lit '03',
|
||||
psterm lit '04',
|
||||
pssleep lit '05',
|
||||
psdq lit '06',
|
||||
psnq lit '07',
|
||||
psflagwait lit '08',
|
||||
psciowait lit '09';
|
||||
|
||||
declare pf$sys lit '00001h',
|
||||
pf$keep lit '00002h',
|
||||
pf$kernal lit '00004h',
|
||||
pf$pure lit '00008h',
|
||||
pf$table lit '00010h',
|
||||
pf$resource lit '00020h',
|
||||
pf$raw lit '00040h',
|
||||
pf$ctlc lit '00080h',
|
||||
pf$active lit '00100h',
|
||||
pf$tempkeep lit '00200h',
|
||||
pf$ctld lit '00400h',
|
||||
pf$childabort lit '00800h',
|
||||
pf$noctls lit '01000h';
|
||||
|
||||
declare pcm$11 lit '00001h',
|
||||
pcm$ctls lit '00002h',
|
||||
pcm$rout lit '00004h',
|
||||
pcm$ctlc lit '00008h',
|
||||
pcm$ctlo lit '00080h',
|
||||
pcm$rsx lit '00300h';
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
|
||||
/* Queue Descriptor */
|
||||
|
||||
dcl qnamsiz lit '8';
|
||||
|
||||
dcl qd$structure lit 'structure(
|
||||
link word,
|
||||
net byte,
|
||||
org byte,
|
||||
flags word,
|
||||
name(qnamsiz) byte,
|
||||
msglen word,
|
||||
nmsgs word,
|
||||
dq word,
|
||||
nq word,
|
||||
msgcnt word,
|
||||
msgout word,
|
||||
buffer word)';
|
||||
|
||||
/* queue flag values */
|
||||
|
||||
dcl qf$mx lit '001h'; /* Mutual Exclusion */
|
||||
dcl qf$keep lit '002h'; /* NO DELETE */
|
||||
dcl qf$hide lit '004h'; /* Not User writable */
|
||||
dcl qf$rsp lit '008h'; /* rsp queue */
|
||||
dcl qf$table lit '010h'; /* from qd table */
|
||||
dcl qf$rpl lit '020h'; /* rpl queue */
|
||||
dcl qf$dev lit '040h'; /* device queue */
|
||||
|
||||
/* Queue Parameter Block */
|
||||
|
||||
dcl qpb$structure lit 'structure(
|
||||
flgs byte,
|
||||
net byte,
|
||||
qaddr word,
|
||||
nmsgs word,
|
||||
buffptr word,
|
||||
name (qnamsiz) byte )';
|
||||
|
||||
|
||||
@@ -0,0 +1,148 @@
|
||||
$ title ('CCP/M-86 1.0, Abort a Program - RSP')
|
||||
$ compact
|
||||
abort:
|
||||
do;
|
||||
|
||||
/* Modified 3/15/83 to force an ATTACH console call */
|
||||
|
||||
$include (:f2:copyrt.lit)
|
||||
$include (:f2:comlit.lit)
|
||||
$include (:f2:mfunc.lit)
|
||||
|
||||
/**** Vax commands for generation:
|
||||
|
||||
$ ccpmsetup !Set up environment
|
||||
$ asm86 rhabt.a86 !Rsp Header ABorT
|
||||
$ plm86 rabt.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug !Rsp ABorT
|
||||
$ link86 rhabt.obj, rabt.obj to rabt.lnk
|
||||
$ loc86 rabt.lnk od(sm(code,dats,data,stack,const))-
|
||||
ad(sm(code(0), dats(10000h))) ss(stack(0)) to rabt.
|
||||
$ h86 rabt
|
||||
|
||||
**** Then, on a micro:
|
||||
A>vax rabt.h86 $fans
|
||||
A>gencmd rabt data[b1000]
|
||||
A>ren abort.rsp=rabt.cmd
|
||||
|
||||
**** Notes:
|
||||
The stack is declared in the assemble module, RSPABT.A86.
|
||||
The const(ants) come last to force hex generation.
|
||||
****/
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (f,a) address external;
|
||||
dcl f byte, a address;
|
||||
end mon3;
|
||||
|
||||
patch: procedure public; /* dummy area for patching code segments */
|
||||
declare i address;
|
||||
/* first statement is 9 bytes, rest are 5 bytes */
|
||||
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
||||
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5; /* about 54 bytes */
|
||||
end patch;
|
||||
|
||||
$include (:f2:proces.lit)
|
||||
|
||||
dcl pd$pointer pointer;
|
||||
dcl pd$ptr structure (offset word, segment word) at(@pd$pointer);
|
||||
dcl pd based pd$pointer pd$structure;
|
||||
|
||||
dcl rsplink word external;
|
||||
|
||||
$include (:f2:qd.lit)
|
||||
|
||||
dcl abt$qd$buf (131) byte;
|
||||
dcl abt$cmd structure(
|
||||
pd address, tail (129) byte);
|
||||
dcl abt$qpb qpb$structure initial(0,0,0,1,.abt$cmd,'ABORT ');
|
||||
dcl abt$qd qd$structure initial (
|
||||
0,0,0,qf$keep + qf$rsp,'ABORT ',131,1,0,0,0,0,.abt$qd$buf);
|
||||
|
||||
dcl fcb (32) byte;
|
||||
dcl pfcb structure (
|
||||
filename address,
|
||||
fcbadr address) initial (.abt$cmd.tail, .fcb);
|
||||
|
||||
declare abort$pb structure (
|
||||
pd address,
|
||||
term address,
|
||||
cns byte,
|
||||
net byte,
|
||||
pname (8) byte) initial (
|
||||
0,00ffh,0,0,' ');
|
||||
|
||||
dcl i byte;
|
||||
dcl console word;
|
||||
dcl mpm$86 lit '1130h';
|
||||
|
||||
/*
|
||||
Main Program
|
||||
*/
|
||||
|
||||
plm$start:
|
||||
procedure public;
|
||||
|
||||
call mon1(m$makeq,.abt$qd); /* make ABORT queue */
|
||||
call mon1(m$openq,.abt$qpb); /* open it */
|
||||
pd$ptr.segment = rsplink;
|
||||
call mon1(m$setprior,200); /* back to the same as transients */
|
||||
|
||||
do while true;
|
||||
call mon1(m$readq,.abt$qpb);
|
||||
pd$ptr.offset = abt$cmd.pd; /* set console to same */
|
||||
call mon1(m$setcns, pd.cns); /* of who typed ABORT */
|
||||
abort$pb.cns = pd.cns;
|
||||
pfcb.filename = mon3(m$parse, .pfcb);
|
||||
/* get name of program to abort */
|
||||
call move (8,.fcb(1),.abort$pb.pname);
|
||||
/* fcb(9)='$'; DEBUG
|
||||
call mon1(m$prtbuf, .fcb(1)); */
|
||||
if pfcb.filename <> 0 then /* console number specified */
|
||||
do;
|
||||
pfcb.filename = mon3(m$parse, .pfcb);
|
||||
i = 1; console = 0;
|
||||
do while fcb(i) <> ' ' and i < 4;
|
||||
if (fcb(i) := fcb(i) - '0') <= 9 then
|
||||
do;
|
||||
console = fcb(i) + 10 * console;
|
||||
i = i + 1;
|
||||
end;
|
||||
else
|
||||
i = 255; /* non - numeric */
|
||||
end;
|
||||
if console > 253 or i = 255 then
|
||||
do;
|
||||
call mon1(m$prtbuf, .(cr,lf, 'Illegal Console, Use 0-253 $'));
|
||||
abort$pb.cns = 0ffh;
|
||||
end;
|
||||
else
|
||||
abort$pb.cns = low(console);
|
||||
end;
|
||||
|
||||
if abort$pb.cns <> 0ffh then
|
||||
if mon2(m$abort, .abort$pb) = 0ffh then
|
||||
do;
|
||||
call mon1(m$prtbuf, .(cr,lf, 'Abort Failed.','$'));
|
||||
end;
|
||||
/* abort first PD found with same name and console */
|
||||
/* consistent with MP/M-80 II but not MP/M 1.x */
|
||||
call mon1(m$attach,0); /* make sure we own the console before */
|
||||
call mon1(m$detach, 0); /* calling detach */
|
||||
pfcb.filename = .abt$cmd.tail;
|
||||
end;
|
||||
end plmstart;
|
||||
end abort;
|
||||
|
||||
@@ -0,0 +1,526 @@
|
||||
$compact
|
||||
$title ('REN: Rename File')
|
||||
ren:
|
||||
do;
|
||||
|
||||
/*
|
||||
Revised:
|
||||
19 Jan 80 by Thomas Rolander
|
||||
31 July 81 by Doug Huskey
|
||||
6 Aug 81 by Danny Horovitz
|
||||
23 Jun 82 by Bill Fitler
|
||||
*/
|
||||
|
||||
$include (:f1:copyrt.lit)
|
||||
|
||||
$include (:f1:vaxcmd.lit)
|
||||
|
||||
$include (:f1:vermpm.lit)
|
||||
|
||||
declare
|
||||
true literally '0FFh',
|
||||
false literally '0',
|
||||
forever literally 'while true',
|
||||
lit literally 'literally',
|
||||
proc literally 'procedure',
|
||||
dcl literally 'declare',
|
||||
addr literally 'address',
|
||||
cr literally '13',
|
||||
lf literally '10',
|
||||
ctrlc literally '3',
|
||||
ctrlx literally '18h',
|
||||
bksp literally '8';
|
||||
|
||||
$include (:f1:proces.lit)
|
||||
|
||||
$include (:f1:uda.lit)
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S INTERFACE *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (func,info) address external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon3;
|
||||
|
||||
mon4:
|
||||
procedure (func,info) pointer external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon4;
|
||||
|
||||
|
||||
|
||||
declare cmdrv byte external; /* command drive */
|
||||
declare fcb (1) byte external; /* 1st default fcb */
|
||||
declare fcb16 (1) byte external; /* 2nd default fcb */
|
||||
declare pass0 address external; /* 1st password ptr */
|
||||
declare len0 byte external; /* 1st passwd length */
|
||||
declare pass1 address external; /* 2nd password ptr */
|
||||
declare len1 byte external; /* 2nd passwd length */
|
||||
declare tbuff (1) byte external; /* default dma buffer */
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
read$console:
|
||||
procedure byte;
|
||||
return mon2 (1,0);
|
||||
end read$console;
|
||||
|
||||
conin:
|
||||
procedure byte;
|
||||
return mon2(6,0fdh);
|
||||
end conin;
|
||||
|
||||
printchar:
|
||||
procedure (char);
|
||||
declare char byte;
|
||||
call mon1 (2,char);
|
||||
end printchar;
|
||||
|
||||
check$con$stat:
|
||||
procedure byte;
|
||||
return mon2(11,0);
|
||||
end check$con$stat;
|
||||
|
||||
print$buf:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$buf;
|
||||
|
||||
version: procedure address;
|
||||
/* returns current cp/m version # */
|
||||
return mon3(12,0);
|
||||
end version;
|
||||
|
||||
search$first:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (17,fcb$address);
|
||||
end search$first;
|
||||
|
||||
search$next:
|
||||
procedure byte;
|
||||
return mon2 (18,0);
|
||||
end search$next;
|
||||
|
||||
delete$file:
|
||||
procedure (fcb$address);
|
||||
declare fcb$address address;
|
||||
call mon1 (19,fcb$address);
|
||||
end delete$file;
|
||||
|
||||
rename$file:
|
||||
procedure (fcb$address) address;
|
||||
declare fcb$address address;
|
||||
return mon3 (23,fcb$address);
|
||||
end rename$file;
|
||||
|
||||
setdma: procedure(dma);
|
||||
declare dma address;
|
||||
call mon1(26,dma);
|
||||
end setdma;
|
||||
|
||||
/* 0ff => return BDOS errors */
|
||||
return$errors:
|
||||
procedure(mode);
|
||||
declare mode byte;
|
||||
call mon1 (45,mode);
|
||||
end return$errors;
|
||||
|
||||
terminate:
|
||||
procedure;
|
||||
call mon1 (143,0);
|
||||
end terminate;
|
||||
|
||||
declare
|
||||
parse$fn structure (
|
||||
buff$adr address,
|
||||
fcb$adr address);
|
||||
|
||||
parse: procedure address;
|
||||
return mon3(152,.parse$fn);
|
||||
end parse;
|
||||
|
||||
declare
|
||||
pd$pointer pointer,
|
||||
pd based pd$pointer pd$structure;
|
||||
declare
|
||||
uda$pointer pointer,
|
||||
uda$ptr structure (
|
||||
offset word,
|
||||
segment word) at (@uda$pointer),
|
||||
uda based uda$pointer uda$structure;
|
||||
|
||||
get$uda: procedure;
|
||||
pd$pointer = mon4(156,0);
|
||||
uda$ptr.segment = pd.uda;
|
||||
uda$ptr.offset = 0;
|
||||
end get$uda;
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* GLOBAL VARIABLES *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
/* Note: there are three fcbs used by
|
||||
this program:
|
||||
|
||||
1) new$fcb: the new file name
|
||||
(this can be a wildcard if it
|
||||
has the same pattern of question
|
||||
marks as the old file name)
|
||||
Any question marks are replaced
|
||||
with the corresponding filename
|
||||
character in the old$fcb before
|
||||
doing the rename function.
|
||||
|
||||
2) cur$fcb: the file to be renamed
|
||||
specified in the rename command.
|
||||
(any question marks must correspond
|
||||
to question marks in new$fcb).
|
||||
|
||||
3) old$fcb: a fcb in the directory
|
||||
matching the cur$fcb and used in
|
||||
the bdos rename function. This
|
||||
cannot contain any question marks.
|
||||
*/
|
||||
|
||||
declare successful lit '0FFh';
|
||||
declare failed (*) byte data(cr,lf,'Not renamed: $'),
|
||||
read$only (*) byte data(cr,lf,'Drive Read Only$'),
|
||||
bad$wildcard (*) byte data('Invalid Wildcard$');
|
||||
declare passwd (8) byte;
|
||||
declare
|
||||
new$fcb$adr address, /* new name */
|
||||
new$fcb based new$fcb$adr (32) byte;
|
||||
declare cur$fcb (33) byte; /* current fcb (old name) */
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* S U B R O U T I N E S *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
crlf: proc;
|
||||
call printchar(cr);
|
||||
call printchar(lf);
|
||||
end crlf;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* fill string @ s for c bytes with f */
|
||||
fill: proc(s,f,c);
|
||||
dcl s addr,
|
||||
(f,c) byte,
|
||||
a based s byte;
|
||||
|
||||
do while (c:=c-1)<>255;
|
||||
a = f;
|
||||
s = s+1;
|
||||
end;
|
||||
end fill;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* error message routine */
|
||||
error: proc(code);
|
||||
declare
|
||||
code byte;
|
||||
|
||||
if code = 0 then do;
|
||||
call print$buf(.('No such file to rename$'));
|
||||
call terminate;
|
||||
end;
|
||||
if code=1 then do;
|
||||
call print$buf(.(cr,lf,'BDOS Bad Sector$'));
|
||||
call terminate;
|
||||
end;
|
||||
if code=2 then do;
|
||||
call print$buf(.read$only);
|
||||
call terminate;
|
||||
end;
|
||||
if code = 3 then
|
||||
call print$buf(.read$only(8));
|
||||
if code = 5 then
|
||||
call print$buf(.('Currently Opened$'));
|
||||
if code = 7 then
|
||||
call print$buf(.('Password Error$'));
|
||||
if code = 8 then
|
||||
call print$buf(.('already exists$'));
|
||||
if code = 9 then do;
|
||||
call print$buf(.bad$wildcard);
|
||||
call terminate;
|
||||
end;
|
||||
end error;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* print file name */
|
||||
print$file: procedure(fcbp);
|
||||
declare k byte;
|
||||
declare typ lit '9'; /* file type */
|
||||
declare fnam lit '11'; /* file type */
|
||||
declare
|
||||
fcbp addr,
|
||||
fcbv based fcbp (32) byte;
|
||||
|
||||
do k = 1 to fnam;
|
||||
if k = typ then
|
||||
call printchar('.');
|
||||
call printchar(fcbv(k) and 7fh);
|
||||
end;
|
||||
end print$file;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* try to rename fcb at old$fcb$adr to name at new$fcb$adr
|
||||
return error code if unsuccessful */
|
||||
rename:
|
||||
procedure(old$fcb$adr) byte;
|
||||
declare
|
||||
old$fcb$adr address,
|
||||
old$fcb based old$fcb$adr (32) byte,
|
||||
error$code address,
|
||||
code byte;
|
||||
|
||||
call move (16,new$fcb$adr,old$fcb$adr+16);
|
||||
call setdma(.passwd); /* password */
|
||||
call return$errors(0FFh); /* return bdos errors */
|
||||
error$code = rename$file (old$fcb$adr);
|
||||
call return$errors(0); /* normal error mode */
|
||||
if low(error$code) = 0FFh then do;
|
||||
code = high(error$code);
|
||||
if code < 3 then
|
||||
call error(code);
|
||||
return code;
|
||||
end;
|
||||
return successful;
|
||||
end rename;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
ucase: proc(c) byte;
|
||||
dcl c byte;
|
||||
|
||||
if c >= 'a' then
|
||||
if c < '{' then
|
||||
return(c-20h);
|
||||
return c;
|
||||
end ucase;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* get password and place at fcb + 16 */
|
||||
getpasswd: proc;
|
||||
dcl (i,c) byte;
|
||||
|
||||
call crlf;
|
||||
call print$buf(.('Password ? ','$'));
|
||||
retry:
|
||||
call fill(.passwd,' ',8);
|
||||
do i = 0 to 7;
|
||||
nxtchr:
|
||||
if (c:=ucase(conin)) >= ' ' then
|
||||
passwd(i)=c;
|
||||
if c = cr then do;
|
||||
call crlf;
|
||||
goto exit;
|
||||
end;
|
||||
if c = ctrlx then
|
||||
goto retry;
|
||||
if c = bksp then do;
|
||||
if i<1 then
|
||||
goto retry;
|
||||
else do;
|
||||
passwd(i:=i-1)=' ';
|
||||
goto nxtchr;
|
||||
end;
|
||||
end;
|
||||
if c = ctrlc then
|
||||
call terminate;
|
||||
end;
|
||||
exit:
|
||||
c = check$con$stat;
|
||||
end getpasswd;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* check for wildcard in rename command */
|
||||
wildcard: proc byte;
|
||||
dcl (i,wild) byte;
|
||||
|
||||
wild = false;
|
||||
do i=1 to 11;
|
||||
if cur$fcb(i) = '?' then
|
||||
if new$fcb(i) <> '?' then do;
|
||||
call print$buf(.failed);
|
||||
call print$buf(.bad$wildcard);
|
||||
call terminate;
|
||||
end;
|
||||
else
|
||||
wild = true;
|
||||
end;
|
||||
return wild;
|
||||
end wildcard;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* set up new name for rename function */
|
||||
set$new$fcb: proc(old$fcb$adr);
|
||||
dcl old$fcb$adr address,
|
||||
old$fcb based old$fcb$adr (32) byte;
|
||||
dcl i byte;
|
||||
|
||||
old$fcb(0) = cur$fcb(0); /* set up drive */
|
||||
do i=1 to 11;
|
||||
if cur$fcb(i) = '?' then
|
||||
new$fcb(i) = old$fcb(i);
|
||||
end;
|
||||
end set$new$fcb;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* try deleting files one at a time */
|
||||
single$file:
|
||||
procedure;
|
||||
declare (code,dcnt,savsearchl) byte;
|
||||
declare (old$fcb$adr,savdcnt,savsearcha) addr;
|
||||
declare old$fcb based old$fcb$adr (32) byte;
|
||||
|
||||
file$err: procedure(fcba);
|
||||
dcl fcba address;
|
||||
call print$buf(.failed);
|
||||
call print$file(fcba);
|
||||
call printchar(' ');
|
||||
call error(code);
|
||||
end file$err;
|
||||
|
||||
call setdma(.tbuff);
|
||||
if (dcnt:=search$first(.cur$fcb)) = 0ffh then
|
||||
call error(0);
|
||||
|
||||
do while dcnt <> 0ffh;
|
||||
old$fcb$adr = shl(dcnt,5) + .tbuff;
|
||||
savdcnt = uda.dcnt;
|
||||
savsearcha = uda.searcha;
|
||||
savsearchl = uda.searchl;
|
||||
call set$new$fcb(old$fcb$adr);
|
||||
if (code:=rename(old$fcb$adr)) = 8 then do;
|
||||
call file$err(new$fcb$adr);
|
||||
call print$buf(.(', delete (Y/N)?$'));
|
||||
if ucase(read$console) = 'Y' then do;
|
||||
call delete$file(new$fcb$adr);
|
||||
code = rename(old$fcb$adr);
|
||||
end;
|
||||
else
|
||||
go to next;
|
||||
end;
|
||||
if code = 7 then do;
|
||||
call file$err(old$fcb$adr);
|
||||
call getpasswd;
|
||||
code = rename(old$fcb$adr);
|
||||
end;
|
||||
if code <> successful then
|
||||
call file$err(old$fcb$adr);
|
||||
else do;
|
||||
call crlf;
|
||||
call print$file(new$fcb$adr);
|
||||
call printchar('=');
|
||||
call print$file(old$fcb$adr);
|
||||
end;
|
||||
next:
|
||||
call setdma(.tbuff);
|
||||
uda.dcnt = savdcnt;
|
||||
uda.searcha = savsearcha;
|
||||
uda.searchl = savsearchl;
|
||||
dcnt = search$next;
|
||||
end;
|
||||
end single$file;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* invalid rename command */
|
||||
bad$entry: proc;
|
||||
|
||||
call print$buf(.failed);
|
||||
call print$buf(.('Invalid File','$'));
|
||||
call terminate;
|
||||
end bad$entry;
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* M A I N P R O G R A M *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
declare ver address;
|
||||
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
plm$start:
|
||||
procedure public;
|
||||
ver = version;
|
||||
if low(ver) < Ver$BDOS or (high(ver) and Ver$Mask) = 0 then
|
||||
call print$buf (.(Ver$Needs$OS,'$'));
|
||||
else do;
|
||||
call get$uda;
|
||||
parse$fn.buff$adr = .tbuff(1);
|
||||
new$fcb$adr, parse$fn.fcb$adr = .fcb;
|
||||
if (parse$fn.fcb$adr:=parse) <> 0FFFFh then do; /* old file */
|
||||
parse$fn.buff$adr = parse$fn.fcb$adr + 1; /* skip delim */
|
||||
parse$fn.fcb$adr = .cur$fcb;
|
||||
parse$fn.fcb$adr = parse; /* new file */
|
||||
call move (8,.cur$fcb+16,.passwd); /* password */
|
||||
end;
|
||||
if parse$fn.fcb$adr = 0ffffh then
|
||||
call bad$entry;
|
||||
if fcb(0) <> 0 then
|
||||
if cur$fcb(0) <> 0 then do;
|
||||
if fcb(0) <> cur$fcb(0) then
|
||||
call bad$entry;
|
||||
end;
|
||||
else
|
||||
cur$fcb(0) = new$fcb(0); /* set drive */
|
||||
if wildcard then
|
||||
call singlefile;
|
||||
else if rename(.cur$fcb) <> successful then
|
||||
call singlefile;
|
||||
end;
|
||||
call mon1(0,0);
|
||||
end plm$start;
|
||||
|
||||
end ren;
|
||||
|
||||
|
||||
@@ -0,0 +1,102 @@
|
||||
; Code and Data Interface for ABORT.RSP
|
||||
; August 10, 1981
|
||||
; July 27, 1982 (updated)
|
||||
; Jan 1983 whf - added reg save to xdos
|
||||
; Mar 1983 dh - shrunk to resonable size
|
||||
|
||||
name rhabt ;Rsp Header ABorT
|
||||
|
||||
cgroup group code
|
||||
dgroup group dats
|
||||
public xdos,mon1,mon2,mon3,mon4
|
||||
public rsplink
|
||||
extrn plmstart:near
|
||||
|
||||
assume cs:cgroup,ds:dgroup
|
||||
|
||||
dats segment 'DATA'
|
||||
org 0
|
||||
rsphdr_len equ 16
|
||||
pd_len equ 30H
|
||||
uda_len equ 100H
|
||||
rsp_top equ 0
|
||||
rsp_pd equ rsp_top + rsphdr_len
|
||||
rsp_uda equ rsp_pd + pd_len
|
||||
rsp_bottom equ rsp_uda + uda_len
|
||||
org rsp_top
|
||||
;RSP header
|
||||
rsplink dw 0 ;becomes system data page paragraph
|
||||
sdatvar dw 0
|
||||
ncopies db 0
|
||||
dw 0,0,0,0, 0
|
||||
db 0
|
||||
org rsp_pd
|
||||
pd dw 0,0 ;link fields
|
||||
db 0 ;status
|
||||
db 190 ;priority
|
||||
dw 3 ;flags - system and keep
|
||||
db 'ABORT ' ;name
|
||||
dw rsp_uda/10h ;uda paragraph
|
||||
db 0,0 ;disk,user
|
||||
db 0,0 ;ldisk,luser
|
||||
dw 0 ;puremem - not re-entrant
|
||||
;rest of pd
|
||||
|
||||
org rsp_uda ;start of uda
|
||||
uda dw 0
|
||||
dw 0 ;DMA must be explicitly set
|
||||
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
|
||||
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
|
||||
dw offset stk_top
|
||||
org rsp_uda + 60H
|
||||
db 1 ;insys = 1, always use UDA stack
|
||||
db 0
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;62
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;6A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;72
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;7A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;82
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;8A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;92
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;9A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;A2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;AA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;B2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;BA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;C2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;CA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;D2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;DA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;E2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;EA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;F2
|
||||
stk_top dw plmstart,0,0 ;initial IRET
|
||||
|
||||
org rsp_bottom
|
||||
|
||||
datsend equ offset $
|
||||
dats ends
|
||||
|
||||
code segment public 'CODE'
|
||||
org 0
|
||||
|
||||
db 'COPYRIGHT (C) 1982,'
|
||||
db ' DIGITAL RESEARCH '
|
||||
|
||||
xdos proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov dx,[bp+4]
|
||||
mov cx,[bp+6]
|
||||
int 224
|
||||
pop bp
|
||||
ret 4
|
||||
xdos endp
|
||||
|
||||
mon1 equ xdos
|
||||
mon2 equ xdos
|
||||
mon3 equ xdos
|
||||
mon4 equ xdos
|
||||
code ends
|
||||
end
|
||||
|
||||
@@ -0,0 +1,102 @@
|
||||
; Code and Data Interface for DIR.RSP
|
||||
; August 10, 1981
|
||||
; July 27, 1982 (updated)
|
||||
; Jan 1983 whf - added reg save to xdos
|
||||
; Mar 1983 dh - shrunk to resonable size
|
||||
|
||||
name rhdir ;Rsp Header DIRectory
|
||||
|
||||
cgroup group code
|
||||
dgroup group dats
|
||||
public xdos,mon1,mon2,mon3,mon4
|
||||
public rsplink
|
||||
extrn plmstart:near
|
||||
|
||||
assume cs:cgroup,ds:dgroup
|
||||
|
||||
dats segment 'DATA'
|
||||
org 0
|
||||
rsphdr_len equ 16
|
||||
pd_len equ 30H
|
||||
uda_len equ 100H
|
||||
rsp_top equ 0
|
||||
rsp_pd equ rsp_top + rsphdr_len
|
||||
rsp_uda equ rsp_pd + pd_len
|
||||
rsp_bottom equ rsp_uda + uda_len
|
||||
org rsp_top
|
||||
;RSP header
|
||||
rsplink dw 0 ;becomes system data page paragraph
|
||||
sdatvar dw 0
|
||||
ncopies db 0
|
||||
dw 0,0,0,0, 0
|
||||
db 0
|
||||
org rsp_pd
|
||||
pd dw 0,0 ;link fields
|
||||
db 0 ;status
|
||||
db 190 ;priority
|
||||
dw 3 ;flags - system and keep
|
||||
db 'DIR ' ;name
|
||||
dw rsp_uda/10h ;uda paragraph
|
||||
db 0,0 ;disk,user
|
||||
db 0,0 ;ldisk,luser
|
||||
dw 0 ;puremem - not re-entrant
|
||||
;rest of pd
|
||||
|
||||
org rsp_uda ;start of uda
|
||||
uda dw 0
|
||||
dw 0 ;DMA must be explicitly set
|
||||
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
|
||||
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
|
||||
dw offset stk_top
|
||||
org rsp_uda + 60H
|
||||
db 1 ;insys = 1, always use UDA stack
|
||||
db 0
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;62
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;6A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;72
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;7A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;82
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;8A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;92
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;9A
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;A2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;AA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;B2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;BA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;C2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;CA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;D2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;DA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;E2
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;EA
|
||||
dw 0cccch,0cccch,0cccch,0cccch ;F2
|
||||
stk_top dw plmstart,0,0 ;initial IRET
|
||||
|
||||
org rsp_bottom
|
||||
|
||||
datsend equ offset $
|
||||
dats ends
|
||||
|
||||
code segment public 'CODE'
|
||||
org 0
|
||||
|
||||
db 'COPYRIGHT (C) 1982,'
|
||||
db ' DIGITAL RESEARCH '
|
||||
|
||||
xdos proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov dx,[bp+4]
|
||||
mov cx,[bp+6]
|
||||
int 224
|
||||
pop bp
|
||||
ret 4
|
||||
xdos endp
|
||||
|
||||
mon1 equ xdos
|
||||
mon2 equ xdos
|
||||
mon3 equ xdos
|
||||
mon4 equ xdos
|
||||
code ends
|
||||
end
|
||||
|
||||
@@ -0,0 +1,105 @@
|
||||
;
|
||||
; Concurrent CP/M-86 v2.0 with BDOS version 3.1
|
||||
; Interface for PLM-86 with separate code and data
|
||||
; Code org'd at 0
|
||||
; Created:
|
||||
; October 5, 1981 by Danny Horovitz
|
||||
; Revised:
|
||||
; 28 Mar 83 by Bill Fitler
|
||||
|
||||
name scd
|
||||
|
||||
dgroup group dats,stack
|
||||
cgroup group code
|
||||
|
||||
assume cs:cgroup, ds:dgroup, ss:dgroup
|
||||
|
||||
stack segment word stack 'STACK'
|
||||
stack_base label byte
|
||||
stack ends
|
||||
|
||||
dats segment para public 'DATA' ;CP/M page 0 - LOC86'd at 0H
|
||||
|
||||
org 4
|
||||
bdisk db ?
|
||||
org 6
|
||||
maxb dw ?
|
||||
org 50h
|
||||
cmdrv db ?
|
||||
pass0 dw ?
|
||||
len0 db ?
|
||||
pass1 dw ?
|
||||
len1 db ?
|
||||
org 5ch
|
||||
fcb db 16 dup (?)
|
||||
fcb16 db 16 dup (?)
|
||||
cr db ?
|
||||
rr dw ?
|
||||
ro db ?
|
||||
buff db 128 dup (?)
|
||||
tbuff equ buff
|
||||
buffa equ buff
|
||||
fcba equ fcb
|
||||
|
||||
org 100h ;past CPM data space
|
||||
saveax dw 0 ;save registers for mon functions
|
||||
savebx dw 0
|
||||
savecx dw 0
|
||||
savedx dw 0
|
||||
public bdisk,maxb,cmdrv,pass0,len0
|
||||
public pass1,len1,fcb,fcb16,cr,rr
|
||||
public ro,buff,tbuff,buffa,fcba
|
||||
public saveax,savebx,savecx,savedx
|
||||
|
||||
dats ends
|
||||
|
||||
|
||||
code segment public 'CODE'
|
||||
public xdos,mon1,mon2,mon3,mon4
|
||||
extrn plmstart:near
|
||||
|
||||
org 0h ; for separate code and data
|
||||
jmp pastserial ; skip copyright
|
||||
jmp patch ; store address of patch routine at start
|
||||
db 'COPYRIGHT (C) 1983, DIGITAL RESEARCH '
|
||||
db ' CONCURRENT CP/M-86 2.0, 03/31/83 ' ; db ' MP/M-86 2.0, 10/5/81 '
|
||||
pastserial:
|
||||
pushf
|
||||
pop ax
|
||||
cli
|
||||
mov cx,ds
|
||||
mov ss,cx
|
||||
lea sp,stack_base
|
||||
push ax
|
||||
popf
|
||||
jmp plmstart
|
||||
|
||||
xdos proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov dx,[bp+4]
|
||||
mov cx,[bp+6]
|
||||
int 224
|
||||
mov saveax,ax
|
||||
mov savebx,bx
|
||||
mov savecx,cx
|
||||
mov savedx,dx
|
||||
pop bp
|
||||
ret 4
|
||||
xdos endp
|
||||
|
||||
mon1 equ xdos ; no returned value
|
||||
mon2 equ xdos ; returns byte in AL
|
||||
mon3 equ xdos ; returns address or word BX
|
||||
mon4 equ xdos ; returns pointer in BX and ES
|
||||
|
||||
patch:
|
||||
nop
|
||||
nop
|
||||
nop
|
||||
nop
|
||||
org 0100h ; leave room for patch area
|
||||
|
||||
code ends
|
||||
end
|
||||
|
||||
@@ -0,0 +1,87 @@
|
||||
name scd1
|
||||
;
|
||||
; CP/M 3.0 MP/M-86 2.0 (BDOS version 3.0)
|
||||
; Interface for PLM-86 with separate code and data
|
||||
; Code org'd at 0
|
||||
; December 18, 1981
|
||||
|
||||
|
||||
dgroup group dats,stack
|
||||
cgroup group code
|
||||
|
||||
assume cs:cgroup, ds:dgroup, ss:dgroup
|
||||
|
||||
stack segment word stack 'STACK'
|
||||
stack_base label byte
|
||||
stack ends
|
||||
|
||||
dats segment para public 'DATA' ;CP/M page 0 - LOC86'd at 0H
|
||||
|
||||
org 4
|
||||
bdisk db ?
|
||||
org 6
|
||||
maxb dw ?
|
||||
org 50h
|
||||
cmdrv db ?
|
||||
pass0 dw ?
|
||||
len0 db ?
|
||||
pass1 dw ?
|
||||
len1 db ?
|
||||
org 5ch
|
||||
fcb db 16 dup (?)
|
||||
fcb16 db 16 dup (?)
|
||||
cr db ?
|
||||
rr dw ?
|
||||
ro db ?
|
||||
buff db 128 dup (?)
|
||||
tbuff equ buff
|
||||
|
||||
public bdisk,maxb,cmdrv,pass0,len0
|
||||
public pass1,len1,fcb,fcb16,cr,rr
|
||||
public ro,buff,tbuff
|
||||
|
||||
dats ends
|
||||
|
||||
|
||||
code segment public 'CODE'
|
||||
public reset,xdos,mon1,mon2,mon3,mon4
|
||||
extrn plm:near
|
||||
|
||||
org 0h ; for separate code and data
|
||||
jmp reset
|
||||
db 'COPYRIGHT (c) 1983 by DIGITAL RESEARCH INC.'
|
||||
reset:
|
||||
pushf
|
||||
pop ax
|
||||
cli
|
||||
mov cx,ds
|
||||
mov ss,cx
|
||||
lea sp,stack_base
|
||||
push ax
|
||||
popf
|
||||
call plm
|
||||
xor cx,cx
|
||||
mov dx,cx
|
||||
int 224
|
||||
|
||||
|
||||
xdos proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov dx,[bp+4]
|
||||
mov cx,[bp+6]
|
||||
int 224
|
||||
pop bp
|
||||
ret 4
|
||||
xdos endp
|
||||
|
||||
mon1 equ xdos ; no returned value
|
||||
mon2 equ xdos ; returns byte in AL
|
||||
mon3 equ xdos ; returns address or word BX
|
||||
mon4 equ xdos ; returns pointer in BX and ES
|
||||
|
||||
org 07fh ; reserve patch area
|
||||
db 0
|
||||
code ends
|
||||
end
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,19 @@
|
||||
|
||||
/* MP/M-86 II User Data Area format - August 8, 1981 */
|
||||
|
||||
declare uda$structure lit 'structure (
|
||||
dparam word,
|
||||
dma$ofst word,
|
||||
dma$seg word,
|
||||
func byte,
|
||||
searchl byte,
|
||||
searcha word,
|
||||
searchabase word,
|
||||
dcnt word,
|
||||
dblk word,
|
||||
error$mode byte,
|
||||
mult$cnt byte,
|
||||
df$password (8) byte,
|
||||
pd$cnt byte)';
|
||||
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
|
||||
/**** VAX commands for generation - read the name of this program
|
||||
for PROGNAME below.
|
||||
|
||||
$ util := PROGNAME
|
||||
$ ccpmsetup ! set up environment
|
||||
$ assign 'f$directory()' f1: ! use local dir for temp files
|
||||
$ plm86 'util'.plm xref 'p1' optimize(3) debug
|
||||
$ link86 f2:scd.obj, 'util'.obj to 'util'.lnk
|
||||
$ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
|
||||
$ h86 'util'
|
||||
|
||||
***** Then, on a micro:
|
||||
A>vax progname.h86 $fans
|
||||
A>gencmd progname data[b1000]
|
||||
|
||||
***** Notes: Stack is increased for interrupts. Const(ants) are last
|
||||
to force hex generation.
|
||||
****/
|
||||
|
||||
@@ -0,0 +1,17 @@
|
||||
|
||||
/* This utility requires MP/M or Concurrent function calls */
|
||||
|
||||
/****** commented out for CCP/M-86 :
|
||||
declare Ver$OS literally '11h',
|
||||
Ver$Needs$OS literally '''Requires MP/M-86''';
|
||||
******/
|
||||
|
||||
declare Ver$OS literally '14h',
|
||||
Ver$Needs$OS literally '''Requires Concurrent CP/M-86''';
|
||||
|
||||
|
||||
declare Ver$Mask literally '0fdh'; /* mask out Is_network bit */
|
||||
|
||||
declare Ver$BDOS literally '30h'; /* minimal BDOS version rqd */
|
||||
|
||||
|
||||
Reference in New Issue
Block a user