seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-12-10 15:23:02 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

538
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/ABORT.RTM Normal file
View File

@@ -0,0 +1,538 @@
;*************************************************************
;*
;* Terminate and Abort Specify Process Entry Points
;*
;*************************************************************
;============== ==============
sysreset_entry: ; System Reset
;============== ==============
xor dx,dx
mov cx,f_terminate
jmp osif
;=============== ===============================
terminate_entry: ; Terminate - DX=terminate code
;=============== ===============================
; This entry point is used for a process to terminate itself. The
; code from the label 'TERMINATE:' on, is also used by a process to be
; terminated when it comes back into context, as set up by
; abort specified process.
mov bx,rlr
call abt_chk
jcxz terminate
jmp term_err
terminate: ;process terminated by abort
mov bx,rlr ;spec resumes execution here
cli ;interrupts off during stack switch
mov ss,p_uda[bx] ;reset the stack to top of UDA
mov sp,ulen
sti
mov p_prior[bx],abt_prior ;finish termination quickly
;abort spec can't force us
;to reenter terminate when
;we have best priority
mov bx,offset thrd_spb ;get ownership of thread
call sync_entry ;list before searching
xor dx,dx
mov bx,(offset thrdrt)-p_thread
mov ax,rlr
nxtchld:
mov bx,p_thread[bx] ;set all child process's p_parent
test bx,bx ! jz nochld ;field to 0
cmp p_parent[bx],ax
jne nxtchld
mov p_parent[bx],dx ;found a child, 0 its parent field
jmps nxtchld
nochld:
mov bx,offset thrd_spb
call unsync_entry
;set parent's child abort flag
mov bx,rlr ;if terminating process's
test p_flag[bx],pf_ctlc ;CTL_C flag is on, ie, we are
jz term_r1 ;terminating from an abort spec
and p_flag[bx],not pf_ctlc ;or control C
mov bx,p_parent[bx]
test bx,bx ! jz term_r1
or p_flag[bx],pf_childabort
term_r1:
mov u_error_mode,0feh ;call BDOS termination
if netversion
mov cx, f_netterm
call osif
endif
mov cx,f_bdosterm
call osif
mov bx,offset q_spb
call sync_entry
call rlsmx ;release all MXqueues
mov bx,offset q_spb
call unsync_entry
mov bx,offset mem_spb ;get ownership of MEM
call sync_entry
mov mem_cnt,1 ;keep MEM from freeing
;the MEM_SPB
mov bx,offset thrd_spb ;get the MEM sync BEFORE
call sync_entry ;the THRD sync to avoid
;deadlock
mov cx,f_freeall ;free all memory except
call osif ;load stack and UDA
mov bx,rlr ;dispatcher does rest of
mov p_stat[bx],ps_term ;termination
jmp dsptch
term_err:
;--------
; entry: CX=1 then can't terminate because KEEP or SYS flag
; CX=0ffffh TEMPKEEP on, CTLC turned on
; called from TERMINATE_ENTRY and ABORT_SPEC_ENTRY
; after call to ABT_CHK:
dec cx ! jz term_err1
;TEMPKEEP and CTLC flag on
xor bx,bx ! mov cx,bx ;and process will terminate
ret ;itself, or needs CTLC information
term_err1:
mov cx,e_pd_noterm ;couldn't term because of
mov bx,0ffffh ! ret ;SYS or KEEP flags,
;CTLC is off
;================
abort_spec_entry: ;Abort the specified process
;================
; entry: DX = address of APB in the caller's U_WRKSEG
; exit: BX = 0 if success, 0FFFFH if failure
; CX = 0 " " , error code if failure
; Set up the specified PD for termination when it is next in context.
; If the running PD is the same as the PD to abort, we can just use
; the terminate entry point. Otherwise we use the Abort Parameter Block
; to find it. If it cannot be found, name and console must both match,
; the abort fails. If the TEMPKEEP flag is on, set the CTLC flag
; and return. If the KEEP flag is on and not the TEMPKEEP flag,
; then fail.
; If the terminate code in DL on entry, is not 0ffh
; and the SYS flag is on in the PD to be aborted, then fail.
; The PD is taken off the list it is attached to via its link field.
; The terminating PD's priority is set to ABT_PRIOR,
; and the address of TERMINATE: is put on top of its UDA stack.
; This forces the terminating process to run next (it has the
; best priority in the system) and for it to resume execution
; at TERMINATE: on returning from the dispatcher.
push dx
mov bx,offset thrd_spb ; get ownership of thread
call sync_entry ; while searching
pop si ; U_WRKSEG:SI->APB
push ds ! mov ds,u_wrkseg
mov bx,apb_pd[si] ; get PD adr to abort
mov cx,apb_term[si] ; get termination/memfree code
mov ah,apb_cns[si] ; console from APB
pop ds
push cx ; save termination code
test bx,bx ! jz abt_findit ; got a PD ID, but not verified
call find_pdthrd ; find it on thread
push cx ; save return code
jmps abt_unsync
abt_findit:
add dx,offset apb_pdname ; get adr of named PD
mov bx,offset thrdrt - p_thread ; find it on thread
call findpdnc ; look for PD name and console match
push cx ; save return code
abt_unsync:
push bx ; BX=PD if found
mov bx,offset thrd_spb
call unsync_entry
pop bx
pop cx ; CX=0 if no PD found
jcxz abt_err1
; successfully found PD
pop dx ; DX = terminate code
mov ax,rlr ; we are aborting ourselves
cmp ax,bx ; jump to TERMINATE_ENTRY
jne abt_notus
;if netversion
; jmp sysreset_entry
;endif
;if not netversion
jmp terminate_entry
;endif
abt_notus:
mov indisp,true ; stop dispatching
;pushf ! cli ; do not let process or another
; process (NO_ABORT_SPEC) change the
or p_flag[bx],pf_ctlc ; flags while testing and acting on them.
call abt_chk ; ok to abort this PD ?
jcxz abt_ok
;popf ; can't abort it - return
call ok_disp
jmps term_err
; The interrupt window above may be lessened if the TERMINATE_ENTRY
; code is moved to the dispatcher and the status is set to PS_TERM.
; Turning interrupts back on, the aborting process could come
; back into context. Before turning on TEMPKEEP it would check
; its status, if it is PS_TERM, then it goes to the dispatcher
; to terminate.
abt_ok: ; this process will be aborted
mov dl,p_stat[bx] ; call abort function based on status
mov dh,0 ! mov di,dx
add di,di
call cs:abort_tab[di] ; find via p_link and take PD off its list
;popf
call ok_disp ; process can't come back into context
; so interrupts are ok
jcxz abt_err2 ; couldn't find PD on list by indicated
mov indisp,false ; by P_STAT
mov p_prior[bx],abt_prior
; set to low priority
push es ; save calling process' UDA
mov es,p_uda[bx] ; UDA of PD being aborted
mov si,(ulen-2) ; reset stack to top of UDA
mov u_sp,si
mov u_ss,es
;if netversion
; mov es:[si],offset sysreset_entry
;endif
;if not netversion
mov es:[si],offset terminate
;endif
; TERMINATE: will be executed when
; terminating process comes back into
; context
xor ax,ax ; on exit from dispatcher interrupts
mov u_flag_sav,ax ; will be off
mov u_inint,false ; return into context with a RET and
; not an IRET
if netversion
inc es:byte ptr u_insys
endif
pop es ; ES=calling PD's UDA
call abt_putdrl
xor bx,bx ; indicate sucess
jmp pdisp ; force abort to happen before we return
; since terminating process has better
; priority
abt_err1:
pop dx ; throw out termination code
abt_err2:
mov cx,e_no_pdname ; set TERM_ERR for other returns
mov bx,0ffffh
ret
; The folowing are the abort handlers for a specific PD status.
; These labels are entered in the abort_tab(le) in the RTM data area.
; Interrupts assumed off.
; For all of the following:
; entry: BX = PD addr to be aborted
; AH = cons
; exit: CX=0 if error
; BX preserved
;
; abort_specified process jump table
;
; Status
abort_tab dw abtrun ; 0 = ready list root
dw abtslp ; 1 = poll
dw abtdly ; 2 = delay
dw abtslp ; 3 = swap
dw abttrm ; 4 = term
dw abtrun ; 5 = sleep
dw abtslp ; 6 = dq
dw abtslp ; 7 = nq
dw abtflg ; 8 = flagwait
dw abtslp ; 9 = ciowait
dw abtslp ; 10 = sync
abt_tablen equ offset $ - offset abort_tab
abtrun:
;-------
; On ready list root or dispatcher ready list
mov di,(offset rlr) - p_link
call find_pd
jcxz abtr_drl
jmps snip_it
abtr_drl: ; wasn't on rlr, try drl
mov di,(offset drl) - plink
jmps abt_common
abtslp:
;------
; On list indicated by u_dparam
; Note: a PD in the SY_NEXT field will not be found
; and cannot be terminated. Usually the PD has TEMPKEEP on
; so it never gets this far.
push es ! mov es,p_uda[bx]
mov di,u_dparam
pop es ! jmps abt_common
abtdly:
;------
mov di,offset dlr - p_link
call find_pd
jcxz abt_tab_err
mov si,p_link[si] ; Fix wait field in next PD on dlr
test si,si
jz ad_nofix ; Are there more PDs after the one
mov dx,p_wait[si] ; being aborted on the DLR ?
add dx,p_wait[bx] ; Add wait of aborting PD
mov p_wait[si],dx ; New value in next PD on dlr
ad_nofix:
jmps snip_it
abttrm:
;------
mov indisp,false
call pdisp ; we are terminating already
xor cx,cx ; make sure termination completes
jmps abt_tab_err ; before returning error
abtflg:
;------
xor cx,cx
push es ! mov es, p_uda[bx]
mov di,u_dparam ; flag PD field asleep on
pop es
cmp bx,[di] ; if interrupts are allowed
jne aflg_err ; in this code, check DRL
inc flg_ignore[di] ; and RLR if not in flags
mov flg_pd[di],flag_off
inc cx
aflg_err:
ret
abt_common:
;----------
call find_pd ! jcxz abt_tab_err
;jmps snip_it
snip_it:
;-------
; Take PD out of linked list of PDs
; entry: BX = PD being snipped out
; DI = offset of previous PD or offset of root - p_link.
mov dx,p_link[bx] ; DX = next link
mov p_link[di],dx
ret ; CX<>0
abt_tab_err:
;-----------
ret ; CX = 0
;
; End of abort_tab(le) functions
;
abt_putdrl:
;-------
; Puts PD on DRL
; entry: BX = PD to insert
; exit: BX preserved
pushf ! cli
mov dx,drl
mov p_link[bx],dx
mov drl,bx
popf ! ret
; Utility routines for abort entry point
findpdnc:
;--------
; Find PD by name and console, via thread list.
; entry: BX = offset of thread list root - p_thread
; DX = adr of name in u_wrkseg
; AH = console number
; ownership of thread sync
; exit: BX = PD
; CX = 0 failure
xor cx,cx
nxt_pdname:
push ax ; save console number
call findpdname_entry
pop ax
jcxz fnc_found_one ; CX = 0 is success from findpdname
xor cx,cx
ret ; CX = 0 is failure from this routine
fnc_found_one: ; found PD w/ same name
cmp p_cns[bx],ah ; chk for same console #
jnz nxt_pdname
inc cx ! ret ; success
find_pdthrd:
;-----------
; Find PD on thread list
; entry: BX = PD address we want
; ownership of thread sync
; exit: CX = 0 if not found
; BX prserved
xor cx,cx
mov di,offset thrdrt - p_thread
fp_next:
mov di,p_thread[di]
test di,di
jz fp_err
cmp bx,di
jne fp_next
inc cx
fp_err:
ret
find_pd:
;-------
; Find PD through link field, interrupts assumed off
; entry: BX = PD address
; DI = offset of list root - p_link
; exit: BX = SI = PD address
; DI = Previous PD
; CX = 0 if failure
mov si,p_link[di]
xor cx,cx
fpd_nxt_pd:
test si,si ; SI could be zero to start
jz fpd_not_found
cmp si,bx ; Are addresses the same ?
jz fpd_found
fpd_nxt_lnk:
mov di,si ; Save previous link
mov si,p_link[si]
jmps fpd_nxt_pd
fpd_found:
inc cx
fpd_not_found:
ret
fflgpd:
;-----
; Find offset into flag table of flag waiting PD
; entry: BX = PD
; exit: DI = offset in RTM data of flag
; CX = 0 if failure
; BX preserved
mov cl,nflags
xor ch,ch
mov di,flags
ffp_nxt_flg:
cmp bx,flg_pd[di] ; assume legal flag
jz ffp_pdfound
add di,flglen
loop ffp_nxt_flg
ffp_pdfound:
ret ; CX is 0 at end of loop instr
; CX <> 0 if found
ok_disp:
;-------
mov indisp,false
cmp drl,0
jz od_ret
call pdisp
od_ret:
ret
abt_chk:
;-------
; Check different PD flags for terminate or abort
; CTLC flag is on if called from ABORT_SPEC
; entry: BX = PD to possibly abort
; DL = termination code
; interrupts off if called from ABORT_SPEC
; exit: CX = 00000H if ok to abort
; 00001H IF NOT OK TO ABORT
; 0FFFFH IF TEMPKEEP
; BX = PD as on entry
; interrupts unchanged
xor cx,cx
mov ax,p_flag[bx] ;AX = PD flags
;test TEMPKEEP first
;for signaling KEEP process
;to terminate i.e., the TMP
;while in the CLI
test ax,pf_tempkeep ! jz ac_keep
or ax,pf_ctlc ;signal control C
dec cx ;temp keep return
jmps ac_ret
ac_keep:
test ax,pf_keep ! jnz ac_no
;not KEEP, test SYS
inc dl ! jz ac_ok ;if DL = 0ffh -> ok to terminate
test ax,pf_sys ! jz ac_ok ;DL<>0ffh & not sys-> ok to terminate
ac_no:
and ax,not pf_ctlc ;turn off ctlc
inc cx ;CX=1, can't terminate
ac_ret:
mov p_flag[bx],ax ;new flags if no termination
ac_ok:
ret
rlsmx:
;-----
; Release all MX queues owned by the terminating process
; called only from TERMINATE_ENTRY
; entry: we own the Queue SYNC
; exit: none
; To guard against queue deletes, and to make interrupt
; windows are smaller, we start over from the beginning of
; QLR after we write to an MXqueue that we own.
mov bx,rlr ;BX=running process
; pushf ! cli
mov si,(offset qlr)-q_link
rm_nxt:
mov si,q_link[si] ;SI=QD currently checking
test si,si ;end of list ?
jz rm_done
test q_flags[si],qf_mx ;is it an MX queue ?
jz rm_nxt
cmp bx,q_buf[si] ;do we own it ?
jne rm_nxt
; popf ;allow interrupts
push si ;put 2-word QPB on stack
xor ax,ax
push ax
mov dx,sp
mov cx,f_qwrite
push ds ;save DS
push ss ! pop ds ;DS=SS
call osif
pop ds ;restore DS
pop ax ! pop ax ;throw out 2-word QPB
jmps rlsmx ;start over from
;top of queue list
;a queue could have been
;deleted while we were writing
rm_done:
; popf
ret


49
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/BASEP.FMT Normal file
View File

@@ -0,0 +1,49 @@
;*****************************************************
;*
;* Base Page Format
;*
;*****************************************************
DSEG
org 0
bpg_clen rb 3
bpg_cseg rw 1
bpg_8080 rb 1
bpg_dlen rb 3
bpg_dseg rw 1
bpg_dxxx rb 1
bpg_elen rb 3
bpg_eseg rw 1
bpg_exxx rb 1
bpg_slen rb 3
bpg_sseg rw 1
bpg_sxxx rb 1
org 050h
bpg_lddsk rb 1
bpg_pw1ptr rw 1
bpg_pw1len rb 1
bpg_pw2ptr rw 1
bpg_pw2len rb 1
org 05ch
bpg_fcb0 rb 0
org 06ch
bpg_fcb1 rb 0
org 80h
bpg_dma rb 0
org 100h
bpg_udata rb 0


40
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/BDOS.A86 Normal file
View File

@@ -0,0 +1,40 @@
include cpyright.def
;*****************************************************
;*
;* BDOS - Basic Disk Operating System
;*
;*****************************************************
;
; generation of BDOS.CON file
;
; RASM86 bdos
; LINK86 bdos.con = bdos [data[origin[0]]]
;
;*****************************************************
eject ! include equ.bdo ; symbol definitions
eject ! include system.dat
eject ! include pd.def
eject ! include qd.def
eject ! include modfunc.def
eject ! include xioscb.def
eject
PCMODE equ false
include bdosif.bdo ; system initialization
eject ! include file1.bdo ; file system part 1
eject ! include file2.bdo ; file system part 2
eject ! include file3.bdo ; file system part 3
eject ! include file4.bdo ; file system part 4
eject ! include file5.bdo ; file system part 5
eject ! include const.bdo
eject ! include patch.cod
eject ! include uda.cic ; User Data area
eject ! include sysdat.bdo
eject ! include data.bdo
end

29
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/CIO.A86 Normal file
View File

@@ -0,0 +1,29 @@
include cpyright.def
;*****************************************************
;*
;* MP/M-86 and Concurrent CP/M-86
;* Character I/O Module
;*
;*****************************************************
eject ! include system.def
eject ! include modfunc.def
eject ! include xioscb.def
eject ! include pd.def
eject ! include err.def
eject ! include qd.def
eject ! include acb.def
eject ! include vccb.def
eject ! include char.def
eject ! include cmode.def
eject ! include cb.def
eject ! include uda.def
eject ! include cioif.cio
eject ! include console.cio
eject ! include chario.cio
eject ! include patch.cod
eject ! include uda.fmt
eject ! include sysdat.dat
eject ! include data.bdo
eject ! end


736
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/COMMAND.SUP Normal file
View File

@@ -0,0 +1,736 @@
;*****************************************************
;*
;* Command Line Interpreter, Program Chain
;*
;*****************************************************
;=========
chain_ent:
;=========
xor dx,dx
;=======
cli_ent:
;=======
; Create a process based on an Ascii Command Line.
; The command Line is first parsed and an FCB is
; initialized as a result.
; An attempt is made to open a queue with the filename
; of the FCB, and with the RSP flag on.
; The command tail is written to the queue if it is found.
; If the queue cannot be opened or is not and RSP type then
; we try and load the command from disk.
; If the write queue fails we return e_q_full error code and
; do not look on the disk.
; After the queue write, an console assign call attempted to
; a process with the same name and the PF_DSKLD flag off.
; Irregardless of the success of the assign we then return.
;
; If the RSP queue cannot be opened, or is not an RSP type queue then
; we make the name type in the
; FCB to be 'CMD' and attempt to open the file. If this fails,
; so do we.
; We then obtain a Process Descriptor from the
; PD table. Again we fail if it does.
; On a successful open, we call the BDOS load function.
; If the load fails, so do we. The PD is
; initialized, the default console is assigned to the
; PD, the PF_DSKLD flag turned on,
; and a create process call is made.
;
; input: DX -> command buffer in u_wrkseg
; It is assumed that the calling process
; is attached to its default console
; and is willing to lose it since it
; will be handed to the newly created
; process.
; if DX = 0, assume chain w/command in DMA
;
; output: BX = 0 if successful
; = 0ffffh if failure has occured
; CX = error code
mov bx,rlr ! mov ax,p_flag[bx]
push ax ;save flags on stack
if netversion
or ax,pf_noctls
endif
if not netversion
or ax,pf_tempkeep + pf_noctls
endif
mov p_flag[bx],ax
if netversion
mov cx,f_no_abort
call osif
endif
push dx ;save parameter
call cli_sync ;rentrancy stops with sync call
pop dx ;we can save the flags
pop cli_pflag ;and other variables in the CLI
;data area
; we have CLI SYNC
; Check for Chain
mov cli_chain,false
cmp dx,0 ! jne cli_cli
mov cli_chain,true
mov cli_term,false
cli_cli:
; initialize defaults from parent PD
mov cli_dfil,false
cmp dayfile,0ffh ! jne nodf
push dx ! mov cx,f_cconattch
call osif ! pop dx
cmp cx,0 ! jne nodf
mov cli_dfil,true
push dx
call prtime
pop dx
nodf: mov bx,rlr
mov cli_ppd,bx
mov cl,p_dsk[bx]
mov cli_dsk,cl
mov cl,p_user[bx]
mov cli_user,cl
mov cl,p_cns[bx]
mov cli_cns,cl
mov cl,u_error_mode
mov cli_err_mode,cl
mov cx,u_dma_ofst
mov cli_dma_ofst,cx
mov cx,u_dma_seg
mov cli_dma_seg,cx
mov clierr,0
; copy command into local area
cmp cli_chain,true ! jne cli_cpy
push es ! push ds
mov es,sysdat
mov si,cli_dma_ofst
mov di,offset cli_cmdtail
mov ds,cli_dma_seg
mov cx,040H
rep movsw
pop ds ! pop es
jmp cli_parse
cli_cpy:
push es ! push ds
mov ds,u_wrkseg ! pop es
; DS=Wrkseg, ES=Sysdat, SP->UDA
; copy clicb_net
mov si,dx ! mov di,offset cli_net
movsb
; copy command
mov si,dx ! add si,clicb_cmd
mov di,offset cli_cmdtail
mov cx,clicblen-clicb_cmd
rep movsb
push es ! pop ds ! pop es
;parse the command
cli_parse:
call pfn ! jcxz cli_gprs
mov clierr,cx
jmp cli_exit
cli_gprs:
call shtal
;fcb has parsed filename
;if not explicit disk then
; if not RSP try CMD
;else try CMD
cmp cli_fcb,0 ! jne cli_ffload
mov bx,(offset cli_fcb)
cmp fcb_plen[bx],0 ! jne cli_ffload
call cli_checkque ! jnz cli_ffload
;successful RSP access
cli_qful:
cmp cli_chain,true ! jne cli_exit2
mov cli_term,true
cli_exit2: jmp cli_exit
cli_ffload:
cmp cx,e_q_full ! jne cli_fload
mov clierr,cx ! jmps cli_qful
cli_checkque:
;------------
; output: z flag on if successful
;copy fcb.name to qpb.name
mov si,(offset cli_fcb)+fcb_name
mov di,(offset cli_cuspqpb)+qpb_name
mov cx,qnamsiz/2 ! push es ! push ds ! pop es
push si ! rep movsw
;copy fcb.name to acb.name
pop si ! mov cx,qnamsiz/2
mov di,(offset cli_acb)+acb_name
rep movsw ! pop es
;open queue
mov cx,f_qopen ! mov dx,(offset cli_cuspqpb)
call osif ! jcxz cli_goodq
retcli1: cmp cx,0 ! ret ;CX = 0ffffh on error
;we successfully opened the queue
;now check RSP flag
cli_goodq:
mov bx,offset cli_cuspqpb
mov bx,qpb_qaddr[bx]
test q_flags[bx],qf_rsp ! jnz cli_gq
mov cx,e_no_queue ! jmps retcli1
;write command tail to queue
cli_gq: mov cx,f_cqwrite ! mov dx,offset cli_cuspqpb
call osif ! jcxz cli_qw
mov cx,e_q_full ! jmps retcli1
;successful queue write, assign console
cli_qw: cmp cli_dfil,true ! jne noqm
call prcusp
noqm: mov bx,offset cli_acb
mov al,cli_cns ! mov acb_cns[bx],al
mov acb_match[bx],false
mov acb_pd[bx],1 ;match on PD with DSKLD flag off
call conasn ! xor cx,cx ! ret
cli_fload:
;---------
; Try to Load a file for execution
; The Command Line Parsed correctly and we have an FCB
; set up. We already know there isn't a queue and a
; process by the same name as the command.
; Obtain a Process Descriptor
pushf ! cli ! mov bx,pul
cmp bx,0 ! jne cli_gpd
popf ! mov clierr,e_no_pd
jmp cli_exit
cli_gpd:
mov si,p_link[bx] ! mov pul,si
popf ! mov cli_pd,bx
; zero PD
push es ! push ds ! pop es
mov di,bx ! mov cx,pdlen/2
xor ax,ax ! rep stosw
pop es
; Initialize the PD for Load
mov bx,cli_pd
mov p_flag[bx],pf_table
mov di,bx ! add di,p_name
mov si,offset cli_fcb ! add si,fcb_name
push es ! mov ax,ds ! mov es,ax
mov cx,pnamsiz/2 ! rep movsw
pop es
mov si,rlr
mov al,cli_dsk ! mov p_dsk[bx],al ;inherit parents drive/user
mov al,cli_user ! mov p_user[bx],al ;even if we load off another
;drive or user
;this should be in
;process create ?
mov al,cli_cns ! mov p_cns[bx],al
mov al,p_lst[si]
;if mpm
; sub al,ncondev
;endif
mov p_lst[bx],al
; 3. Open the file
mov si,(offset cli_fcb)+fcb_pwd
mov di,offset cli_dma
push es ! mov es,sysdat
mov cx,4 ! rep movsw
pop es
mov u_dma_ofst,offset cli_dma
mov u_dma_seg,ds
mov si,offset cli_fcb
mov byte ptr fcb_type[si],'C'
mov byte ptr fcb_type+1[si],'M'
mov byte ptr fcb_type+2[si],'D'
; Open the CMD file
mov u_error_mode,0feh
call flopn
cmp bl,0ffh ! jne cli_gopen
; on failure,
; if default is not system disk
; and not an explicit disk then
; try CMD file on System disk
cmp bh,0 ! jne cli_bo ;extended error
mov cl,srchdisk
cmp cl,cli_dsk ! je cli_bo ;already on system disk
cmp cli_fcb,0 ! jne cli_bo ;check for explicit
;select
; try system disk
; mov bx,rlr
; mov p_dsk[bx],cl
inc cl
mov cli_fcb,cl ;set drive byte to
call flopn ;system disk
cmp bl,0ffh ! je cli_bo
;make sure SYS attribute is on...
mov bx,offset cli_fcb
test byte ptr fcb_type+1[bx],080h ! jnz cli_gopen
;We opened a NON-SYS file. Do explicit open
;on user zero if not already
call flclse
mov bx,rlr
cmp p_user[bx],0 ! je cli_boe
mov p_user[bx],0
call flopn
cmp bl,0ffh ! je cli_bo
mov bx,offset cli_fcb
test byte ptr fcb_type+1[bx],080h
jnz cli_gopen
call flclse
jmps cli_boe
;could not find CMD file
cli_bo: cmp bh,0 ! jne cli_rmpd2
cli_boe: mov clierr,e_bad_open
cli_rmpd2: jmp cli_rmpd
cli_gopen:
; 8. Call the load function
mov bx,rlr
test p_flag[bx],pf_ctlc ! jz cli_ld1
mov bx,0ffffh ! mov cx,e_abort
jmp cli_cl
cli_ld1:
cmp cmod,true ! jne not_cmod
mov bx,cli_pd
mov si,offset cli_fcb
;test F1 bit
mov p_cmod[bx],0
test byte ptr fcb_name[si],080h ! jz not_f1
or p_cmod[bx],080h
;test F2 bit
not_f1: test byte ptr fcb_name+1[si],080h ! jz not_f2
or p_cmod[bx],040h
;test F3 bit
not_f2:
;if mpm dave brown test
test byte ptr fcb_name+2[si],080h
jz not_f3
;endif
or p_cmod[bx],020h
;test F4 bit
not_f3: test byte ptr fcb_name+3[si],80h ! jz not_cmod
or p_cmod[bx],070h
not_cmod:
cmp cli_chain,true ! jne cli_kuda
mov bx,cli_pd
mov p_uda[bx],es
mov ax,offset inituda
mov cl,4 ! shr ax,cl
add ax,sysdat
mov bx,es ! mov es,ax ! mov di,0
mov ds,bx ! mov si,di
mov cx,ulen/2
rep movsw
pushf ! cli ! pop dx
mov ax,es
mov ds,sysdat
mov ss,ax
mov bx,rlr
mov p_uda[bx],ax
push dx ! popf
cli_kuda:
cmp cli_dfil,true ! jne noprfil
call prfilnam
call crlf
noprfil:mov bx,cli_pd
mov dx,offset cli_fcb
mov cx,f_load
cmp cli_chain,true ! jne cli_ld
mov cli_term,true
mov cx,f_cload
call osif
jcxz cli_cl
mov cli_term,false
jmp cli_cl
cli_ld: call osif
cli_cl: push bx ! push cx
mov u_error_mode,0
call flclse
pop cx ! pop bx
jcxz cli_gload
cmp cx,e_abort ! jne cli_lnab
jmp cli_rmpd
cli_lnab: mov clierr,cx
jmp cli_rmpd
cli_gload:
mov cli_bpage,bx
; 9a. Parse Command Tail
; copy cmdtail to user DMA buffer
push es ! mov es,cli_bpage
mov di,offset bpg_dma+1
mov si,offset cli_cmdtail
mov cx,127
rep movsb ! pop es
; count cmd length and convert
; to upper case
push ds ! mov ds,cli_bpage
mov cl,0 ! mov di,offset bpg_dma+1
ncmdchar:
cmp byte ptr [di],0 ! je endtail
; convert CMD tail to UPPER CASE
cmp byte ptr [di],'a' ! jb nlow
cmp byte ptr [di],'z' ! ja nlow
and byte ptr [di],05fh
nlow:
inc di ! inc cl ! jmps ncmdchar
endtail:
mov bpg_dma,cl ! pop ds
; load disk init, location 50H
; of base page is done in LOAD
push es ! mov es,cli_bpage
; init default fcb
mov di,offset bpg_fcb0
xor ax,ax ! stosb ;default disk
mov al,' '
mov cx,11 ! rep stosb ;name,type
xor ax,ax
mov cx,2 ! rep stosw ;other
push ds ! push es ! pop ds
mov si,offset bpg_fcb0
mov cx,8 ! rep movsw
pop ds ! pop es
; if cmdtail, parse
cmp cli_cmdtail,0 ! je ctdone
call pfn
cmp bx,0ffffh ! je ctdone
; copy fcb to user fcb front
push es ! mov es,cli_bpage
mov di,offset bpg_fcb0
mov si,offset cli_fcb
mov ax,fcb_pptr[si]
; AX->password in CLI_CMDTAIL
sub ax,offset cli_cmdtail
add ax,offset bpg_dma + 1
; AX->password in Base Page
mov es:bpg_pw1ptr,ax
mov al,fcb_plen[si]
mov es:bpg_pw1len,al
mov cx,8 ! rep movsw ! pop es
; if more cmdtail, parse
cmp bx,0 ! je ctdone
push cli_pcb ! inc bx
mov cli_pcb,bx
call pfn
pop cli_pcb
cmp bx,0ffffh ! je ctdone
; copy 2nd fcb front
push es ! mov es,cli_bpage
mov di,offset bpg_fcb1
mov si,offset cli_fcb
mov ax,fcb_pptr[si]
; AX->password in CLI_CMDTAIL
sub ax,offset cli_cmdtail
add ax,offset bpg_dma + 1
; AX->password in Base Page
mov es:bpg_pw2ptr,ax
mov al,fcb_plen[si]
mov es:bpg_pw2len,al
mov cx,8
rep movsw
pop es
ctdone:
; 10. Create the process
cmp cli_chain,true ! jne nprior
mov cx,f_setprior
mov dx,1 ! call osif
nprior:
mov si,cli_pd ! or p_flag[si],pf_dskld ;from disk, to differ
mov dx,si ! mov cx,f_createproc ;from RSP with same name
call osif
; 11. Assign Console to new process
mov bx,rlr
and p_flag[bx],not pf_ctlc
; Check to see if user hit CTRL D
test p_flag[bx],pf_ctld ! jz asgn
and p_flag[bx],not pf_ctld
mov bx,cli_pd
or p_flag[bx],pf_ctld
jmp cli_exit
asgn: mov bx,offset cli_acb
mov al,cli_cns ! mov acb_cns[bx],al
mov ax,cli_pd ! mov acb_pd[bx],ax
mov acb_match[bx],true
call conasn
mov clierr,cx
jmps cli_exit
; 12. All Done
cli_rmpd: ; release PD
mov si,cli_pd
; Release any memory that might still be
; associated with the PD. This could
; happen from a CTRL C.
cmp p_mem[si],0 ! je rmpd1
push ds ! push es
push si
mov si,p_mem[si]
push ms_start[si]
mov cx,f_memfree
mov dx,sp
mov ax,ss ! mov ds,ax
call osif
pop ax ! pop si
pop es ! pop ds
jmps cli_rmpd
; Place empty PD on PUL.
rmpd1: pushf ! cli
mov bx,pul
mov p_link[si],bx ! mov pul,si
popf
; Normal EXIT
cli_exit: ; close file and release CLI SYNC
mov bx,rlr
mov cl,cli_dsk ! mov p_dsk[bx],cl
mov cl,cli_user ! mov p_user[bx],cl
mov cl,cli_err_mode ! mov u_error_mode,cl
mov cx,cli_dma_ofst ! mov u_dma_ofst,cx
mov cx,cli_dma_seg ! mov u_dma_seg,cx
cmp cli_chain,true ! jne clirls
mov bx,rlr ! mov si,cli_pd ;inherit calling PD's
mov ax,p_parent[bx] ;parent if chaining
mov p_parent[si],ax
cmp cli_term,true ! jne clirls
and p_flag[bx],not (pf_keep+pf_sys+pf_tempkeep+pf_ctlc)
if netversion
mov p_tkcnt[bx],0
endif
mov cx,f_terminate ;TERM_ACT in dispatcher
jmp osif ;releases CLI_SYNC
clirls:
push cli_pflag
push cli_err
call cli_unsync
if netversion
mov cx,f_ok_abort
call osif
endif
pop dx
if netversion
pop ax ! and ax,pf_noctls
endif
if not netversion
pop ax ! and ax,pf_tempkeep+pf_noctls
endif
mov bx,rlr ! mov cx,p_flag[bx]
if netversion
and cx,not pf_noctls
endif
if not netversion
and cx,not pf_tempkeep+pf_noctls
endif
or cx,ax ! mov p_flag[bx],cx
test p_flag[bx],pf_ctlc ! jz cli_nctl
mov cx,f_terminate ! xor dx,dx
call osif
and p_flag[bx],not pf_ctlc
mov dx,e_abort
; setup error return if needed
cli_nctl:
mov cx,dx
xor bx,bx
jcxz cli_gexit
mov bx,0ffffh
cli_gexit:
ret
shtal:
;---------
; setup command tail to be parsed
; input: AX = output of previous parsefilename
cmp ax,0 ! je ntail
;shift command tail to beginning
;of command buffer
push ax ! sub ax,offset cli_cmdtail
mov cx,128 ! sub cx,ax ! shr cx,1
pop si ! mov di,offset cli_cmdtail
push es ! push ds ! pop es
rep movsw ! pop es
ret
ntail:
mov cli_cmdtail,0
ret
;============================
; Various string subroutines
crlf: mov dl,13 ! call prchar
mov dl,10
;jmps prchar
prchar:
mov si,u_conccb
mov di,rlr
cmp [si],di ! jne prr
mov cx,f_conout ! jmp osif
prr: ret
prtime: mov dl,tod_hr ! call prnum
mov dl,':' ! call prchar
mov dl,tod_min ! call prnum
mov dl,':' ! call prchar
mov dl,tod_sec ! call prnum
mov dl,' ' ! jmps prchar
prnum: push dx ! mov cl,4
shr dl,cl ! add dl,'0'
call prchar
pop dx ! and dl,0fh
add dl,'0' ! jmps prchar
prfilnam:
call prdisk
mov dx,(offset cli_fcb)+fcb_name
call prnam
mov dl,'.' ! call prchar
mov dx,(offset cli_fcb) + fcb_type
call prtyp
mov dl,' ' ! call prchar
mov bx,offset cli_fcb
test byte ptr fcb_name+7[bx],080h ! jnz pruser
cmp cli_user,0 ! je pret
mov bx,rlr
cmp p_user[bx],0 ! je pruser
pret: ret
pruser: mov dx,offset userstr
jmps prcsm
prdisk: mov dl,cli_fcb
cmp dl,0 ! je prpddsk
dec dl ! jmps prdsk1
prpddsk:
mov bx,rlr
mov dl,p_dsk[bx]
prdsk1: add dl,'A' ! call prchar
mov dl,':' ! jmp prchar
prcusp: mov dx,(offset cli_cuspqpb) + qpb_name
call prnam ! mov dx,offset questr
call prcsm ! jmp crlf
prcsm: mov si,u_conccb
mov di,rlr
cmp [si],di ! jne prr1
xor bx,bx ! push ds
mov ax,cs ! mov ds,ax
call cprnt1 ! pop ds
prr1: ret
prtyp: mov bh,3 ! jmps prn1
prnam: mov bh,8
prn1: mov bl,' '
mov si,u_conccb
mov di,rlr
cmp [si],di ! jne prr1
cprnt1: mov cx,f_conprint ! jmps jos
flclse:
mov cx,f_fclose ! mov dx,offset cli_fcb
jmps fo1
flopn:
mov cx,f_fopen
mov si,offset cli_fcb
or byte ptr fcb_name+5[si],080h ;f6`=open read-only
mov dx,si
fo1: push es ! call osif ! pop es ! ret
cli_sync:mov cx,f_sync
jmps mx1
cli_unsync: mov cx,f_unsync
mx1: mov bx,offset cli_spb
jos: jmp osif
pfn: mov dx,offset cli_pcb ! mov cx,f_parsefilename
jmps jos
conasn: mov cx,f_conassign ! mov dx,offset cli_acb
jmps jos
questr db ' Msg Qued',0
userstr db '(User 0)',0


246
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/CPMMEM.MEM Normal file
View File

@@ -0,0 +1,246 @@
;*****************************************************
;*
;* MEM Entry Points
;*
;*****************************************************
; Format of Memory Control Block used
; in CP/M-86 Memory Calls (53 - 58)
;
; +-----------+-----------+-----+
; MCB | Base | Length | ext |
; +-----------+-----------+-----+
;
mcb_base equ word ptr 0
mcb_length equ word ptr mcb_base + word
mcb_ext equ byte ptr mcb_length + word
mcblen equ mcb_ext + byte
;============ =====================
maxmem_entry: ; 53 - Get Max Memory
;============ =====================
; input: DX = address of MCB in u_wrkseg
; output: BX = 0ffffh if failure
; 0h if success
; CX = Error Code
; mcb_ext = 0 if no additional mem
; 1 if more available
mov si,dx
push ds ! mov ds,u_wrkseg
mov dx,mcb_length[si] ! pop ds
sub ax,ax ! mov bx,ax
call getmemory ! jcxz mm_gm
mov bx,0ffffh ! ret
mm_gm: push ds ! mov ds,u_wrkseg
mov mcb_length[si],dx
mov mcb_base[si],ax
mov mcb_ext[si],1
pop ds ! sub bx,bx ! ret
;============
absmax_entry: ; 54 - Get Abs Max Mem
;============
; Allocate the largest absolute memory region which
; is less than or equal mcb_length
; input: DX = address of MCB in u_wrkseg
; output: BX = 0ffffh if failure
; 0h if success
; CX = Error Code
mov si,dx
push ds ! mov ds,u_wrkseg
mov ax,mcb_base[si]
mov dx,mcb_length[si] ! pop ds
sub bx,bx
call getmemory ! jcxz am_gm
mov bx,0ffffh ! ret
am_gm: push ds ! mov ds,u_wrkseg
mov mcb_length[si],dx
mov mcb_base[si],ax
pop ds ! sub bx,bx ! ret
;==============
cpmalloc_entry: ; 55 - Alloc Mem
;==============
; Allocate a memory region which is equal to mcb_length
;
; input: DX = address of MCB in u_wrkseg
; output: BX = 0ffffh if failure
; 0h if success
; CX = Error Code
mov si,dx
push ds ! mov ds,u_wrkseg
sub ax,ax ! mov bx,mcb_length[si]
mov dx,bx ! pop ds
call getmemory ! jcxz ca_gm
mov bx,0ffffh ! ret
ca_gm: push ds ! mov ds,u_wrkseg
mov mcb_length[si],dx
mov mcb_base[si],ax
pop ds ! sub bx,bx ! ret
;=============
cpmabsa_entry: ; 56 - Alloc Abs Mem
;=============
; Allocate an absolut memory region which is
; equal to mcb_length. Note: For CP/M-86
; compatibility, this function must return success
; if the memory is already allocated because
; the GET MAX functions allocate memory in MP/M, CCP/M
; and not in CP/M.
;
; input: DX = address of MCB in u_wrkseg
; output: BX = 0ffffh if failure
; 0h if success
; CX = Error Code
mov si,dx
push ds ! mov ds,u_wrkseg
mov ax,mcb_base[si]
mov bx,mcb_length[si]
mov dx,bx ! pop ds
; See if We already own this memory
; SI -> MCB in U_WRKSEG
; AX=Base, BX=Length, DX=Length
xor cx,cx
mov di,rlr
add di,p_mem-ms_link
caa_n: mov di,ms_link[di]
cmp di,0 ! je caa_g
cmp ms_start[di],ax ! jne caa_n
cmp ms_length[di],bx ! jbe caa_gm
mov cx,e_no_memory
mov bx,0ffffh ! ret
; SI -> MCB in U_WRKSEG
; AX=Base, BX=Length, DX=Length
caa_g: call getmemory ! jcxz caa_gm
mov bx,0ffffh ! ret
; Successful allocation
caa_gm: push ds ! mov ds,u_wrkseg
mov mcb_length[si],dx
mov mcb_base[si],ax
pop ds ! sub bx,bx ! ret
getmemory:
;---------
; input: AX = start
; BX = min
; DX = max
; output: AX = start
; DX = length
; CX = error code
; preserve SI
push si
sub cx,cx ! push cx ! push cx ! push dx ! push bx
push ax ! mov dx,sp
push ds ! mov cx,ss ! mov ds,cx
mov cx,f_malloc ! call osif
pop ds ! pop ax ! pop dx ! pop bx ! pop bx ! pop bx
pop si ! ret
;=============
cpmfree_entry: ; 57 - Free Mem
;=============
; Free memory as specified in MCB
; input: DX = offset of MCB in u_wrkseg
; mcb_ext = 0ffh = free all but load mem
; else as specified by mcb_base.
; mcb_base = seg addr of memory segment
; to free. IF in middle of
; existing segment then just free
; the end of the segment.
push ds ! mov ds,u_wrkseg
mov si,dx
mov al,mcb_ext[si]
mov dx,mcb_base[si] ! pop ds
cmp al,0ffh ! jne free_memory
cpmf_root: mov bx,rlr
add bx,p_mem-ms_link
cpmf_next: mov si,ms_link[bx]
cmp si,0 ! jne try_seg
sub bx,bx ! mov cx,bx ! ret
try_seg: test ms_flags[si],mf_load ! jz free_seg
mov bx,si ! jmps cpmf_next
free_seg: mov dx,ms_start[si]
push si ! call free_memory ! pop si
jcxz cpmf_root
jmps cpmf_next
free_memory:
;-----------
; input: DX = start
; output: BX = 0,0ffffh (success,fail)
; CX = Error Code
push ds ! push ss ! pop ds
sub cx,cx ! push cx ! push dx
mov dx,sp
mov cx,f_memfree ! call osif
pop dx ! pop dx ! pop ds
ret
;=============
freeall_entry: ; 58 - Free All Mem
;=============
; Free all memory except LOAD UDA and LDSTK
; If a transient program calls this, it must free up the
; all of the perceived memory. The UDA and LDSTK is not
; perceived by CPM compatible programs. The UDA cannot be
; freed, since it is part of the process descriptor, until
; termination in the dispatcher.
mov si,rlr
mov ax,p_uda[si]
add si,p_mem-ms_link
fam_n: mov si,ms_link[si]
; See if anymore memory to free
cmp si,0 ! je fam_e
mov bx,ms_start[si]
; See if UDA above start
cmp bx,ax ! ja fam_a ;AX=UDA Segment
mov cx,bx
add cx,ms_length[si]
; See if below start+len
cmp cx,ax ! jb fam_a
; WE HAVE A UDA !!!
; see if we already trimmed it
test ms_flags[si],mf_udaonly
jnz fam_n
or ms_flags[si],mf_udaonly
; trim the memory above the UDA
; check if it's an 8087 user
mov bx,rlr ;get process
test p_flag[bx],pf_8087 ;if not an 8087 user
jz med_uda ;try medium uda len
add ax,(lstklen+u8087len)/16 ;else use long uda
jmp done_uda
med_uda: test p_sflag[bx],psf_em87 ;if not 87 emulator
jz norm_uda ;do normal uda len
add ax,(lstklen+em87len)/16 ;else do medium len
jmp done_uda
norm_uda: add ax,(lstklen+ulen)/16 ;CX=# paragraphs
done_uda: mov bx,ax
; Free the segment or after the UDA+LDSTK
fam_a: mov dx,bx
call free_memory
jmps freeall_entry
fam_e: xor bx,bx ! mov cx,bx ! ret


689
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/DSPTCH.RTM Normal file
View File

@@ -0,0 +1,689 @@
;*****************************************************
;*
;* Dispatch Routines
;*
;*****************************************************
;=====
fdisp:
;=====
; This entry point used by interrupt routines in XIOS
; Note: if the XIOS is performing memory protection interrupt
; handlers must enable O.S. memory before calling the O.S.
cli
push ds ! mov ds,sysdat
cmp indisp,true ! je nodisp ;if indisp=true then we are
mov ax_sav,ax ;in the dispatcher and
mov al,true ! mov indisp,al ;this code is skipped
mov ax,es ! mov es_sav,ax
mov ax,rlr ! xchg ax,bx ! mov bx_sav,ax
mov es,p_uda[bx]
mov al,true ! mov u_in_int,al
pop ax ! mov u_ds_sav,ax
mov al,p_stat[bx]
mov u_stat_sav,al
mov p_stat[bx],ps_run
mov ax,es_sav
mov u_es_sav,ax
; AX in AX_SAV
; BX in BX_SAV
; ES in U_ES_SAV
; DS in U_DS_SAV
; p_stat in U_STAT_SAV
jmp intdisp
;dispatcher will jump to here if
; u_in_int = true.
int_disp_exit: ;interrupts are off
; AX in AX
; BX in BX
; ES in U_ES_SAV
; DS in U_DS_SAV
; p_stat in U_STAT_SAV
mov ax_sav,ax
mov ax,bx ! mov bx_sav,ax
;check for
cmp drl,0 ! jnz intdisp ;interrupt occurence
;on dispatcher exit
mov al,false ! mov u_in_int,al
mov ax,rlr ! mov bx,ax
mov al,u_stat_sav
mov p_stat[bx],al
mov ax,bx_sav ! mov bx,ax
mov ax,ax_sav
mov indisp,false
mov ds,u_ds_sav
mov es,u_es_sav
iret
nodisp: pop ds
iret
;========
farpdisp:
;========
; Intermodule pdisp (non-interrupt)
call pdisp ! retf
;=====
pdisp:
;=====
; Call dispatcher with no special action
push bx ! mov bx,rlr
mov p_stat[bx],ps_run ! pop bx
;jmp dsptch
;======
dsptch:
;======
; The dispatch function looks like a noop to the
; caller. All flags and registers are maintained.
; No levels of user stack is used.
; (jmp dispatch = ret)
; Interrupt routines enter through fdisp.
;
; Dispatch has two (2) arguments:
; 1. the p_stat field of the process descriptor
; determines the type of action to perform
; for this process.
; 2. the dparam field of the uda is an argument
; to the action.
; The main part of the dispatch routine takes the
; currently running process off the Ready list
; and jmps to a routine which will put it on some
; other list depending on the p_stat argument.
; The subsequent routine will then jump to the
; scheduler which will do polling of devices and
; move processes off the dispatch ready list onto
; the Ready list. The Ready List is maintained
; in priority order with round-robin scheduling
; of processes with equivalent priorities. The
; first process on the ready list will then be
; switched in.
; set indisp flag
pushf ! cli
cmp indisp,true ! jne dispin
popf ! ret
dispin: mov indisp,true
pop u_flag_sav
; assumming bx=RLR:
; if PLR=0 and DRL=0 then
; if p_stat[bx]=PS_RUN then
; if p_link[bx]=0 or
; p_prior[p_link[bx]]<>p_prior[bx] then
; don't do dispatch
mov ax_sav,ax
mov ax,bx ! mov bx_sav,bx
intdisp:
cmp plr,0 ! jne dcont ;if Poll list = 0 and
cmp drl,0 ! jne dcont ;Dsptch Ready list = 0 and
mov ax,rlr ! mov bx,ax ;(RLR can never be 0 here)
cmp p_stat[bx],ps_run ! jne dcont ;our status is run and
cmp p_link[bx],0 ! je no_disp2 ;other PD to ready to run
mov al,p_prior[bx] ;with an equal priority
mov bx,p_link[bx] ;THEN skip the dispatch
cmp al,p_prior[bx] ! je dcont
no_disp2:
mov ax,bx_sav ! mov bx,ax
mov ax,ax_sav
jmp dext
dcont:
mov u_ss,ss ! mov u_sp,sp
mov ss,sysdat ! mov sp,offset dsptchtos
mov ax,bx_sav ! mov bx,ax
mov ax,ax_sav
sti
cld
; save registers
; NOTE: We will use DS instead of ES
; No segment overrides...
push es ! pop ds
mov ds:u_ax,ax
mov ax,bx ! mov ds:u_bx,ax
mov ax,cx ! mov ds:u_cx,ax
mov ax,dx ! mov ds:u_dx,ax
mov ax,di ! mov ds:u_di,ax
mov ax,si ! mov ds:u_si,ax
mov ax,bp ! mov ds:u_bp,ax
; Save interrupt vectors 0,1,3,4 not INT 2 which is NMI
; MP/M-86, CCP/M-86 1.0 on the IBM PC saved NMI
; Block move first 2
xor bx,bx ! mov ds,bx
mov si,bx ! mov di,offset u_ivectors
mov dx,4
mov cx,dx ! rep movsw
mov cx,dx ! add si,dx ;get next 2
add di,dx ;skip INT 2 location documented
rep movsw ;now as reserved word in UDA
; block move osint,debugint
mov si,offset i_os_ip ! mov di,offset u_os_ip
mov cx,dx ! rep movsw
mov ds, sysdat
; if 8087 emulator user,swap extra vectors
mov bx,rlr
test p_sflag[bx],psf_em87
jz u_disp ; not an emulator user
push es ! mov ax,ds ; save segment registers
push cx! push di
mov cx, em_seg ; move 14 vectors from
mov si, em_offs ; low memory to uda extension
mov di, offset u_8087
mov es, p_uda[bx]
mov ds,cx
mov cx, tot_emvecs/2
rep movsw
pop di ! pop cx
pop es ! mov ds,ax ; restore segment registers
; swap out userdisp vectors.
; acts like a nop to non-userdisp processes
u_disp:
mov si,rlr
mov ax,user_save
callf p_userdisp[si]
jmps dcont1
def_emultr: ; this is the default routine for non-userdisp proc's
retf
dcont1: ; take current process off RLR.
;disable memory for the process
;we are taking out of context
;turn off interrupts ?
;dsp_disabled:
nop
mov ax,rlr ! mov si,ax
mov ax,p_link[si] ! mov rlr,ax
mov p_link[si],0
; We are now in NO-MAN's land
; From now until the end of the
; switch routine, There is no
; process in context.
; SI -> PD just taken out of context.
; jump to routine for given status
xor bh,bh ! mov bl,p_stat[si] ! shl bx,1
jmp cs:dsp_table[bx]
org ((offset $)+1) AND 0fffeh
dsp_table dw disp_act ;00 - run
dw disp_act ;01 - (nop)-poll device
dw delay_act ;02 - delay
dw disp_act ;03 - (nop)-swap
dw term_act ;04 - terminate
dw sleep_act ;05 - sleep
dw disp_act ;06 - (nop)-dq
dw disp_act ;07 - (nop)-nq
dw flag_act ;08 - flag wait
dw disp_act ;09 - (nop)-ciowait
dw disp_act ;10 - (nop)-sync
sleep_act:
;---------
; insert running process into list specified by
; u_dparam and set p_stat from p_scratch
; Note: we cannot sleep on the DLR since interrupts are on
; here, and flag_set can change the DLR
mov ax,u_dparam
mov bx,ax
push si ! call insert_process
pop si ! or p_flag[si],pf_resource
mov al,p_scratch[si] ! mov p_stat[si],al
jmp schedule
delay_act:
;---------
; Put the running process on the Delay List. The
; delay list is built such that any process's
; remaining delay time is the additive of the delay
; times of all processes ahead of it plus the # of
; ticks in it's own p_wait field. At each clock tick
; the p_wait field of the top process in the list
; is decremented. If it reaches zero (0), all
; processes with a zero in the p_wait field are
; placed on the dispatch ready list.
; input: SI=pd address
cli ;keep flag set from changing
;if mpm ;TICK, and changing DLR
; push si ! mov al,io_strtclk
; call xiosif ! pop si
;endif
;if ccpm
mov tick,true
;endif
mov bx,(offset dlr)-p_link
mov cx,u_dparam ! inc cx
cmp cx,0 ! jne del_lp
dec cx
del_lp: mov di,p_link[bx]
cmp di,0 ! je del_o
mov ax,p_wait[di]
cmp ax,cx ! ja del_o
sub cx,ax ! mov bx,di ! jmps del_lp
del_o: mov p_link[si],di ! mov p_link[bx],si
mov p_wait[si],cx
cmp di,0 ! je del_e
sub p_wait[di],cx
del_e: jmp schedule
flag_act:
;--------
; place running process in flag table to wait
; for next flag. Note, flag may have been set...
; input: SI=pd address
; U_DPARAM=address of Flag entry
mov ax,u_dparam ! mov bx,ax
cli ;protect from flag set
cmp flg_pd[bx],flag_on ! je gflagon
mov flg_pd[bx],si ! mov p_link[si],0
jmp schedule
gflagon: ; Flag set since wait check
mov flg_pd[bx],flag_off
sti
jmps disp_act
term_act:
;--------
; Terminate the running process, free memory, free pd, free sync
; structures. Can only be called by TERMINATE_ENTRY.
; input: SI=pd address
; MEM_SYNC owned by calling process
; place PD on rlr for now.
mov ax,rlr
mov p_link[si],ax
mov rlr,si
; clean up consoles
mov cx,f_cioterm ! call osif
; clean up memory
; (we own the MXmemory queue)
free_nxt:
mov ax,rlr ! mov si,ax
mov si,p_mem[si]
test si,si ! jz end_free
push ds ! xor cx,cx ! push cx
push ms_start[si]
mov ax,ss ! mov ds,ax ! mov dx,sp
mov cx,f_memfree ! call osif
pop bx ! pop cx ! pop ds
jmps free_nxt
end_free:
;release any sync structures
;after releasing memory
mov mem_cnt,0 ;and MEM_CNT=1
;on entry, also own THRD_SYNC
;so it is safe to call
;FREEPD below,
;ASSIGN_SYNC cannot be called
;with the THRD_SPB
;SI=terminating process
mov bx,offset slr - sy_link ;release any sync structures
t_nsync: ;owned by terminating PD
mov bx,sy_link[bx]
test bx,bx ;end of syncs?
jz t_sync_done
push bx ;PD cannot be allowed to
call unsync_entry ;abort if in SY.NEXT
pop bx
jmps t_nsync
t_sync_done:
; take off RLR
mov si,rlr
mov ax,p_link[si]
mov rlr,ax
mov p_link[si],0
cmp si,owner_8087 ;release 8087 if we owned it
jne t_end ! mov owner_8087,0
t_end:
; free up PD
call freepd ! jmp schedule
disp_act:
;--------
; place process on RLR
; input: SI=pd address
mov p_stat[si],ps_run
mov bx,(offset rlr)-p_link
call insert_process ! jmp schedule
;==============
insert_process:
;==============
;
; put PD# in list ordered by priority
;
; entry: BX = list root
; SI = pd number
; exit: SI is preserved
; interrupt state as on entry
mov cx,pflag[si] ! and cx,pf_resource
;if a process was waiting
ins_npd: mov di,p_link[bx] ;on a resource, insert
test di,di ! jz ins_out ;it ahead of equal priority
mov al,p_prior[di] ;process
cmp al,p_prior[si]
ja ins_out ;lowest priority first
jb ins_nxt ;higher - keep going down list
jcxz ins_nxt ;equal and not resource
jmps ins_out ;equal & resource
ins_nxt: mov bx,di ! jmp ins_npd
ins_out: jcxz ins_exit
and p_flag[si],not pf_resource
ins_exit:
mov p_link[si],di ! mov p_link[bx],si ! ret
;========
schedule:
;========
; poll all required devices and place any ready
; processes on the Ready List
;we can enable interrupts now.
;there MUST be a process on the RLR
;at this point, ie. IDLE...
sti
;go through the Poll List
mov di,(offset plr)-p_link
;get the next PD on list.
;DI is the last one which
;has already been checked.
polld_another:
mov si,p_link[di]
;SI is the next PD to check
test si,si ! jz drltorlr
;SI is valid PD, poll it.
;If top PD on the PLR has a worse
;priority compared to top PD on the RLR,
;there is no reason to call the XIOS
;and poll the device, this time through
;the dispatcher. We must poll on equal
;priority to keep a compute bound
;process and the CLOCK from locking
;out a polling process.
;Note, we stop polling after
;the first process that has polled
;successfully, or we get to the end of
;the PLR. The process is placed on
;the RLR.
mov bx,rlr ! test bx,bx ;if RLR=0: poll
jz poll_it
mov al,p_prior[si] ;priority of 1st poll PD
cmp al,p_prior[bx] ! jbe poll_it ;poll if equal or better
jmps drltorlr ;priority than head of RLR
poll_it:
push di
;if mpm
; mov cx,p_wait[si]
;endif
;if ccpm
mov dx,p_wait[si]
;endif
mov al,io_polldev ! call xiosif
pop di ! mov si,p_link[di]
;if AL=0, device not ready.
cmp al,0 ! je polld_next
;device ready,
;move SI from PLR to RLR
mov ax,p_link[si] ! mov p_link[di],ax
mov bx,(offset rlr)-p_link
mov p_stat[si],ps_run
call insert_process ;got one ready to run:
jmps drltorlr ;stop polling
;p_link[SI]=next PD to check
polld_next: ;SI has been checked
mov di,si ! jmps polld_another
drltorlr:
;--------
; Pull all processes on the dispatch ready list and
; place them on the Ready List.
;We must disable interrupts while
;playing with DRL since interrupts
;doing a Flag_set may also.
;We must competely drain the DRL since
;it is in no particular order.
cli ! mov si,drl ;protect DRL from flag set
test si,si ! jz switch
mov ax,p_link[si] ! mov drl,ax
; test ax,ax ;is this the last PD on DRL?
; jnz drl_noi ;yes - don't turn on interrupts
sti ;interrupts off guarentees
;drl_noi: ;the last DRL PD with the
mov p_stat[si],ps_run ;best priority will run
mov bx,(offset rlr)-p_link ;next and at least until
call insert_process ;it turns on interrupts
jmps drltorlr
switch:
;------
; switch to the first process on the Ready List
sti
mov bx,rlr
; if no next process, go back ;
; to schedule. Gives more immediate ;
; response to polled and interrupt ;
; driven devices ;
switch0:
test bx,bx ! jnz switch1 ;
jmp schedule ;
; Suspendable processes: in order to be suspended, a process
; must be flagged as suspendable, it must be in the background,
; and it must not be in the system (e.g.,owning a system queue).
; It must also not be coming into context to terminate.
switch1:
cli ;check if process should suspend
mov ax,p_sflag[bx]
test ax,psf_suspend
jz switch2 ;no, not at all
mov al,p_cns[bx] ;Check vccb's state word
xor ah,ah ! xor di,di
mov di,ccblen ! mul di
mov di,ccb ! add di,ax
mov ax,c_state[di]
test ax,csm_background ;Has it gone into background ?
jz switch2 ;no, don't need to suspend
push es
mov es,p_uda[bx]
mov al,u_insys ;Is it in the system? If so, don't
test al,al ;suspend.
pop es
jne switch2
test p_flag[bx],pf_ctlc ;Is it terminating ?
jnz switch2 ;Yes, don't put it back on list.
mov ax,p_link[bx] ;All conditions apply; take it off
mov rlr,ax ;the RLR.
mov ax,splr ;Get the suspend list
mov p_link[bx],ax ;link up and
mov splr,bx ;place on top of suspend list.
mov p_stat[bx],ps_ciowait ;change its status
mov ax,c_state[di] ;Turn on suspend if process was
test ax,csm_suspend ;created in the background.
jnz do_dparam
or c_state[di],csm_suspend
do_dparam:
push es ;Put list root into u_dparam
mov es,p_uda[bx] ;for terminate's pd search.
mov u_dparam, offset splr
pop es
mov bx,rlr ;BX = RLR
sti
jmp switch0 ;make sure next process isn't suspendable
;enable memory for this process
;turn on interrupts ?
;
; ;Save and restore the 8087 environment if process to run
; ;uses the 8087 and is not the owner. Interrupts
; ;must be on. Code from Intel Ap. Note. 113 page 29
;
; ;This code shouldn't be added unless interrupt windows in
; ;switch are allowed or the 8087 restore is separated
; ;from the 8086/8088 restore. The switch code without this
; ;commented out 8087 code,
; ;creates an interrupt window approx. 100 to 200 micro
; ;secs on 5 to 4 meg CPU.
; ;Allowing interrupt windows in switch
; ;means we must check on leaving the dispatcher
; ;for an interrupt awakened process (DRL again <> 0)
; ;and call the
; ;dispatcher again to prevent a 16 milli second wakeup time
; ;for a PD doing a flagwait after the interrupt service routine.
; ;Calling the dispatcher at the end of the dispatch
; ;(see commented out code at end of dispatcher and at
; ;INT_DISP_EXIT:)
; ;creates contention problems between PDs waiting for a resource
; ;and PDs waking up from interrupts. It cannot be guarenteed
; ;who will run next. An interrupt awakened process can
; ;get a just freed resource is should have waited for.
; ;The RTM ASSIGN_SYNC_ENTRY is an untested solution
; ;for allowing interrupts in the dispatcher switch code.
switch2:
sti ;BX=PD to run next
test p_flag[bx],pf_8087 ;does this process use the NDP?
jz try_em87 ;if not, see if it emulates 8087
cmp bx,owner_8087 ;do we already own it
je done8087
mov dx,ds ;DX = DS = SYSDAT
fwait ;wait until other process is done
xchg bx,owner_8087 ;new owner, also set by terminate
test bx,bx ! jz get8087 ;no one owns it if BX=0
mov ds,p_uda[bx] ;old owner's UDA
fstcw ds:u_8087 ;save IEM bit status
nop ;delay while 8087 busy saves control reg
fdisi ;disable 8087 busy signal
mov ax,ds:u_8087 ;get original control word
fsave ds:u_8087 ;save NPX context
fwait ;IEM=1.wait for save to finish
mov ds:u_8087,ax ;save original control word
mov ds,dx ;DS = SYSDAT
mov es,p_uda[bx] ;swap out and save this user's
mov di,offset u_ivec87_of ;ndp interrupt vector
mov si,iofs_87 ;DS:SI = system's vector address
mov ds,iseg_87 ;ES:DI = user's UDA save area
mov cx,2! rep movsw
mov ds,dx ;restore DS to SYSDAT
get8087:
mov bx,rlr
mov ds,p_uda[bx] ;PD to run next
frstor ds:u_8087 ;copy in its 8087 environment frsure
push ds ;DS=UDA . UDA on stack.
restore87_int:
mov ds,dx
les di,dword ptr iofs_87 ;restore interrupt vectors
mov ds, p_uda[bx] ;for 8087 user
mov si, offset u_ivec87_of
mov cx, 2 ! rep movsw
jmps restore
try_em87: ;8087 emulator has special vector
test p_sflag[bx],psf_em87 ;set that must be swapped
jz done8087
mov ax,ds ;save DS
mov cx,em_seg ;move 14 vectors from uda extension
mov di,em_offs ;to low memory
mov si,offset u_8087 ;u_8087 -> user save area in uda
mov ds,p_uda[bx]
mov es,cx
mov cx,tot_emvecs/2
rep movsw
mov ds,ax ;restore DS
done8087: ;no more 8087 or emulator business...
;BX=PD to run next
mov dx,p_uda[bx] ! mov ds,dx ;DS=UDA
push dx ;UDA on stack
restore:
mov es, sysdat ;Restore userdisp vectors.
mov ax, es:user_restore ;Acts like a nop to non-userdisp
mov si, es:rlr ;processes.
callf es:p_userdisp[si] ;Default routine does a retf.
xor ax,ax ! mov es,ax ! mov di,ax
mov si,offset u_ivectors
mov dx,4
mov cx,dx ! rep movsw ;restore interrupt vectors 0,1
mov cx,dx ! add di,dx ;don't touch NMI
add si,dx ;skip what was NMI
rep movsw ;restore interupt vectors 3,4
mov si,offset u_os_ip ;DS=UDA
mov di,offset i_os_ip
mov cx,dx ! rep movsw
; restore registers
mov ax,ds:u_bx ! mov bx,ax
mov ax,ds:u_cx ! mov cx,ax
mov ax,ds:u_dx ! mov dx,ax
mov ax,ds:u_si ! mov si,ax
mov ax,ds:u_di ! mov di,ax
mov ax,ds:u_bp ! mov bp,ax
mov ax,ds:u_ax
; restore DS and ES and stack
pop es ;ES=UDA
cli ;turn interrupts off for rest
mov ss,u_ss ;of exit
mov sp,u_sp
mov ds,sysdat
dext:
cmp u_in_int,true ! jne dret
jmp int_disp_exit
dret:
push u_flag_sav
mov indisp,false
cmp drl,0 ! je dd_ret
popf ; someone is on DRL from interrupt during
jmp pdisp ; switch, dispatch now, no 16ms wait
dd_ret:
popf
ret


40
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/FINDPD.RTM Normal file
View File

@@ -0,0 +1,40 @@
;*****************************************************
;*
;* Find Process Descriptor
;*
;*****************************************************
;================ =================================
findpdname_entry: ; Find Process Descriptor by Name
;================ =================================
; Find process by name in thread list
; Before calling this routine, calling process must
; own the THRD_SPB (Thread Sync Parameter Block) as
; interrupts are not turned off.
;
; input: DX->name in u_wrkseg
; BX->thread list root - p_thread
; output: BX=pd if found
; =0ffffh if not found
; CX=0 if found
; =e_no_pdname if not found
push es ! mov es,u_wrkseg
fpn_cmpname:
mov si,dx
mov bx,p_thread[bx]
cmp bx,0 ! je fpn_nomatch
mov cl,0
lea di,p_name[bx]
fpn_cmplet:
cmp cl,8 ! je fpn_found
mov al,es:[si] ! sub al,[di]
shl al,1 ! jnz fpn_cmpname
inc cl ! inc si ! inc di
jmps fpn_cmplet
fpn_found: mov cx,0 ! jmps fpn_exit
fpn_nomatch:
mov cx,e_no_pdname ! mov bx,0ffffh
fpn_exit:
pop es ! ret


185
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/FLAG.RTM Normal file
View File

@@ -0,0 +1,185 @@
;*****************************************************
;*
;* Flag Management
;*
;* FLAGS-flag table offset NFLAGS-number of flags
;*
;* Format of Flag Table Entry:
;* +-------------+------+
;* | flag |ignore|
;* +-------------+------+
;* flag - 00000h, flag can be allocated
;* flag - 0ffffh, flag is off but is allocated to some
;* function.
;* 0fffeh, flag is set
;* 0xxxxh, PD that is waiting
;* ignore- 0ffh, normal case
;* 0xxh, number of flags to ignore-1
;*
;* GENSYS initializes the flags reserved by the system
;* and the XIOS header to 0ffh's. The rest of the
;* flags are initialized to 0 by GENSYS.
;*
;*****************************************************
;============
;getfree_flag:
;============
; input: DX = 0 then allocate a flag
; else
; if DH = 0FFH then release flag number
; DL (0 relative)
; output:
; BX = flag allocated if getting a flag
; or 0FFFFH if no flag is available
; BX = 0FFFFH if attempting to release a
; no existent flag
; CX = 0 no error
; CX = 4 if illegal flag number
; CX = 27H if no more flags to allocate
;
; Flags reserved by CCP/M or MP/M and the XIOS
; header, cannot be released.
;
;turn off interrupts
;
; test dx,dx ! jz rf_alloc
; inc dh ! jnz rf_enum
; cmp dl,nrsv_flags ! jbe rf_enum
; cmp dl,nflags ! jae rf_enum
; xor ax,ax ! mov bx,ax ! mov cx,ax
; mov al,dl
; add al,dl ! add al,dl
; mov si,ax ! mov word ptr flags[si],0
; mov byte ptr flags 2[si],0
; ret
;rf_alloc:
; mov si,flags ! xor ax,ax
; mov bx,ax ! mov cx,nflags
;rf_nxt:
; cmp ax,[si] ! je rf_foundone ;got one
; add si,3 ! inc bx
; loop rf_nxt
; mov cx,e_noflags ! jmps rf_err
;rf_foundone:
; mov cx,ax ;0 CX
; dec ax
; mov [si],ax ;set the 3 bytes to 0ffh
; mov 2[si],al
; ret
;rf_enum:
; mov cx,e_illflag
;rf_err:
; mov bx,0ffffh
; ret
;============== ==========================
flag_set_entry: ; Set Logical Interrupt Flag
;============== ==========================
; NOTE: the flagset routine can (must?) be called from outside
; the operating system through an interrupt
; routine. UDA variables cannot be used. This
; is the only function an interrupt routine can
; call.
;
; input: DL = flag number
; output: BX = 0 if okay,0ffffh if error
; CX = if error: e_flag_ovrrun
call flag_valid
cmp cl,flag_tick ! jne notick
mov bx,dlr
test bx,bx ! jz dlr_null ;no process waiting
dec p_wait[bx] ! jnz nxt_tick
nxt_tpd:
mov si,p_link[bx] ! mov dlr,si ;SI,DLR=next waiting PD
mov p_stat[bx],ps_run ;put PD done waiting
mov ax,drl ! mov p_link[bx],ax ;on DRL
mov drl,bx
test si,si ! jz dlr_null ;SI=next waiting PD
cmp p_wait[si],0 ! jnz nxt_tick
mov bx,si ! jmps nxt_tpd;another process was waiting
;the same number of ticks
nxt_tick: jmp flag_exit ;wait for next tick
dlr_null: ;DLR is empty turn off
mov tick,false ! jmp flag_exit ;XIOS tick flag
no_tick:
cmp flg_ignore[si],flag_zig ! je fs_set
dec flg_ignore[si] !
mov cx,e_flag_ignr ! jmp flag_bexit
fs_set: cmp bx,flag_on ! jne fs_non
mov cx,e_flag_ovrrun ! jmp flag_bexit
fs_non: cmp bx,flag_off ! jne fs_noff
mov flg_pd[si],flag_on
jmp flag_exit
fs_noff:mov ax,drl ! mov p_link[bx],ax
mov drl,bx ! mov p_stat[bx],ps_run
or p_flag[bx],pf_resource ;12/4/83
mov flg_pd[si],flag_off
jmp flag_exit
;=============== ===============================
flag_wait_entry: ; Wait for Logical Interrupt Flag
;=============== ===============================
; input: DL = flag number
; output: BX = 0 if everything okay
; BX = 0ffffh if Error
; CX = Error Code:0,e_flag_underrun
call flag_valid
cmp bx,flag_on ! jne fw_non
mov flg_pd[si],flag_off
jmp flag_exit
fw_non: cmp bx,flag_off ! jne fw_noff
mov bx,rlr
mov p_stat[bx],ps_flagwait
mov u_dparam,si
call dsptch ! jmp flag_exit
fw_noff:mov cx,e_flag_underrun ! jmp flag_bexit
flag_valid: ; Check validity of flag number
;---------- -----------------------------
; entry: DL = flag number
; output: SI = ptr to flag entry
; BX = contents of flag entry
; CL = flag number
; clear interrupt flag - Flags on stack
pop ax ! pushf ;AX=return address
cmp dl,nflags ! jb flag_good
flag_bad:
mov cx,e_ill_flag ! jmp flag_bexit ;flags and next return
flag_good: ;address on stack
mov cl,dl ;save flag number
xor dh,dh ! push ax ! cli ;return to fset/fwait on stack
mov ax,dx ;multiply flag number
mov bx,ax ;times 3
add ax,ax ;*2
add ax,bx ;*3
mov si,flags ! add si,ax
mov bx,[si]
;test bx,bx ;FLAG field cannot be 0
;jz flag_bad
ret
flag_exit: ; Successful Exit
;--------- ---------------
; entry: flags and return from flagset or flagwait on stack
xor bx,bx ! popf ! ret
flag_bexit: ; Exit with Error
;---------- ---------------
; entry: flags and return from flagset or flagwait on stack
xor bx,bx ! dec bx
popf ! ret


29
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/IDLE.SUP Normal file
View File

@@ -0,0 +1,29 @@
;*****************************************************
;*
;* Idle Process
;*
;*****************************************************
;====
idle: ;Idle Process
;====
; Jump to the XIOS idle routine
;if mpm
; mov ds,sysdat
; mov bx,rlr
; mov es,p_uda[bx]
; mov ax,io_idle
; jmp xiosif
;endif
;if ccpm ;we could move idle to the RTM
mov ds,sysdat ;and initialize its IP:CS to
mov bx,rlr
mov ax,p_uda[bx] ;point to the dispatcher
mov es,ax ;and get rid of this
mov cx,f_dispatch ;code since idle will never
call osif ;come out of the dispatcher
jmps idle
;endif


123
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/INIT.SUP Normal file
View File

@@ -0,0 +1,123 @@
;*****************************************************
;*
;* Concurrent CP/M-86 Supervisor Initialization
;*
;*****************************************************
cseg
org 0
jmp init ;system initialization
jmp entry ;intermodule entry pt.
;next 3 words are set by GENSYS
sysdat dw 0 ;segment
supervisor dw entry ;offset
dw 0 ;segment
org 0ch
dev_ver db 6 ;development system data version
;set in sysdat.dat
db 'COPYRIGHT (C) 1982,1983,1984'
db ' DIGITAL RESEARCH '
db 'XXXX-0000-'
serial db '654321'
;====
init:
;====
; system initialization
; DS set to Sysdat Segment by loader
;make INIT a process:
;set up init stack
cli ! cld ;Loader enters here
mov ax,ds ;with interrupts
mov ss,ax ! mov sp,offset (init_tos) ;possibly on
;initialize init uda
mov bx,offset initpd
mov ax,offset inituda
mov cl,4 ! shr ax,cl
add ax,sysdat ! mov p_uda[bx],ax
mov es,ax
mov u_wrkseg,ds
;we now look like we are in the O.S. as usual:
;DS=SYSDAT seg, ES=UDA, U_WRKSEG=PD's DS.
; set up mpm entry point
push ds
xor ax,ax ! mov ds,ax
mov i_os_ip,offset user_entry
mov i_os_cs,cs
pop ds
;initialize ndp owner to default
mov ax, 0ffffh ; ffff = no ndp chip present in system
mov owner_8087,ax
;initialize modules
mov bx,mod_init
push bx ! callf dword ptr rtmmod[bx] ! pop bx ; init RTM
push bx ! callf dword ptr memmod[bx] ! pop bx ; init MEM
test module_map,bdosmod_bit ! jz nbdo
push bx ! callf dword ptr bdosmod[bx] ! pop bx ; init BDOS
nbdo: test module_map,ciomod_bit ! jz ncio
push bx ! callf dword ptr ciomod[bx] ! pop bx ; init CIO
ncio: test module_map,xiosmod_bit ! jz nxio
push ds ! push es
callf dword ptr xiosmod[bx] ! pop es ! pop ds ; init XIOS
nxio:
; reset interrupt vectors after XIOS INIT
mov ax,ds ! sub bx,bx ! mov ds,bx
mov i_os_ip,offset user_entry
mov i_os_cs,cs
mov ds,ax
; get Character Dev Info from XIOS
;if mpm
; mov ax,io_maxconsole ! call xiosif
; mov ncondev,bl ! mov nciodev,bl
; mov ax,io_maxlist ! call xiosif
; mov nlstdev,bl ! add nciodev,bl
; mov bx,offset initpd
; mov al,ncondev
; mov p_lst[bx],al
;endif
; Init CCB and LCB adr in INIT UDA so
; child processes will inherit them
mov cl,f_conattach ! int osint
mov cl,f_lstattach ! int osint
; Start RSPs
nrsp: ;loop til done
mov ds,sysdat ;reset DS
mov cx,rspseg ! jcxz rsp_o ;?all done?
mov es,cx ;ES->RSP
mov ax,es:.rsp_link ;save next RSP
mov rspseg,ax
mov es:.rsp_link,ds ;give Sysdat to RSP
mov si,rsp_pd ;get PD
mov ds,cx ;DS = RSP Data Seg
mov p_mem[si],0
mov cl,f_createproc ;Create RSP Process(s)
mov dx,si ! int osint
jmps nrsp ;Do another...
rsp_o:
; terminate init process
mov cl,f_terminate
mov dl,0ffh ! int osint


978
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/LOAD.SUP Normal file
View File

@@ -0,0 +1,978 @@
;*****************************************************
;*
;* Program Load
;*
;*****************************************************
;
; LDTAB Entry Format:
; 0 2 4 6 8
; +-----+-----+-----+-----+-----+-----+-----+-----+
; | START | MIN | MAX | PD |
; +-----+-----+-----+-----+-----+-----+-----+-----+
;
; 8 10(A) 12(C) 14(E) 16(10) 17(11)
; +-----+-----+-----+-----+-----+-----+-----+-----+-----+
; | ATR | FSTRT | FLEN | TYPE| ID |
; +-----+-----+-----+-----+-----+-----+-----+-----+-----+
;
;
; start Absolute Address requested
; min Min memory wanted
; max Max memory wanted
; pd PD to allocate to
; atr Attributes, Memory Flags
; fstrt Starting paragraph in File
; flen # of paragraphs in file
; type Group type
; id Segment Address of this group
;
; The Load Table contains 9 entries, One for each
; potential Group in Command File and One extra
; for Independent Memory Allocations.
ldt_start equ word ptr 0
ldt_min equ word ptr ldt_start + word
ldt_max equ word ptr ldt_min + word
ldt_pd equ word ptr ldt_max + word
ldt_atr equ word ptr ldt_pd + word
ldt_fstrt equ word ptr ldt_atr + word
ldt_flen equ word ptr ldt_fstrt + word
ldt_type equ byte ptr ldt_flen + word
ldt_id equ word ptr ldt_type + byte
ldtlen equ ldt_id + word
;=========
cload_ent: ; entry point to load for a chain command
;=========
; Assumes UDA is set in passed PD.
push bx ! mov bx,1
jmps load
;========
load_ent: ; User entry point to load .CMD file for execution
;========
; input: DX = address of open FCB in u_wrkseg
; output: BX = segment addr of Base Page
; = 0ffffh if error
; CX = Error Code
sub bx,bx
;jmp load
;====
load: ; Intermodule entry point to load .CMD file
;====
; input: DX = addr of open FCB in u_wrkseg
; BX = addr of unused PD to initialize
; 0 - do not init PD
; 1 - chain load (PD addr on stack)
; output: BX = seg addr of Base Page
; = 0ffffh if error
; CX = Error Code
; Get MXLoad Queue
push dx ! push bx
mov cx,f_qread ! mov dx,offset mxloadqpb
call osif
mov lod_chain,false
pop lod_pd ! pop si
cmp lod_pd,1 ! jne ld_cf
pop lod_pd ! mov lod_chain,true
; Copy FCB into lod_fcb
; SI-> user FCB in u_wrkseg
ld_cf: mov cx,fcblen/2 ! mov di,offset lod_fcb
push es ! push ds ! push ds
mov ds,u_wrkseg ! pop es
rep movsw
pop ds ! pop es
; Read the Header
mov bx,offset lod_fcb
mov byte ptr fcb_r0+2[bx],0
mov ax,0 ;record #
mov bx,1 ;# of sectors
mov dx,offset lod_dma ;DMA offset
mov cx,sysdat ;DMA segment
call drd ! cmp di,1 ;check for EOF in header read
je lod_eof
jcxz ndpchk
lod_eof:
mov cx, e_bad_load ; tried to load a 0 length cmd file
mov bx, 0ffffh ; or one whose header is incorrect
jmp lod_exit
ndpchk: ;see if 8087 required
mov lod_ndp,0 ;default = no
mov bx, offset lod_dma
test ch_lbyte[bx],need_8087
jz ndp_flg ;not required - but is it optional?
cmp owner_8087,0ffffh ;needs it,but is there one in system?
jnz ndp_yes ;yes- flag it
mov cx,e_nondp ;no - abandon load & return
mov bx, 0ffffh
jmp lod_exit
ndp_flg:
test ch_lbyte[bx],opt_8087 ;will use it if present?
jz h_hdr ;doesn't want it at all
cmp owner_8087,0ffffh ;will use it,but is there one ?
jnz ndp_yes ;if not, flag it as an emulator user
mov lod_ndp,1
jmp h_hdr
ndp_yes:
mov lod_ndp,0ffh ;flag it as an 8087 user
h_hdr:
mov lod_suspnd,0 ;default = no suspend needed
test ch_lbyte[bx],susp_mode ;require background suspension ?
jz h_hdr1 ;no...
mov lod_suspnd,0ffh ;yes, flag pd later
h_hdr1:
mov lod_indma,0
; initialize Load Disk and User
; from FCB
mov bx,rlr
mov al,p_user[bx]
mov lod_user,al
mov al,p_dsk[bx] ;default disk of calling PD
mov lod_disk,al ;1-15 -> A-P
mov bx,offset lod_fcb
mov al,fcb_dr[bx]
mov lod_fifty,al ;base page address 50H, 0=default
test al,al ! jz use_ddsk
dec al ;1-15 -> A-P
mov lod_disk,al
use_ddsk:
test byte ptr fcb_name+7[bx],080h ! jz use_dusr
mov lod_user,0
use_dusr:
; Initialize ldtab
; Zero ldtab
mov cx,ldtabsiz/2 ! sub ax,ax
mov di,offset ldtab
push es ! mov es,sysdat
rep stos ax ! pop es
; 1st ldtab entry is UDA and LSTK
; if a PD was specified...
mov lod_nldt,0
mov si,offset ldtab
cmp lod_pd,0 ! jne sel_uda
jmp gc_ifo
sel_uda: cmp lod_ndp,0 ;see if 8087 user and long
jz form_uda ;uda is needed
cmp lod_ndp,0ffh ;no...
jz form_87uda
form_emuda: mov ldt_min[si],(lstklen+em87len)/16 ;8087 emulator user
mov ldt_max[si],(lstklen+em87len)/16 ;64 byte extension
jmp cont_uda
form_87uda: mov ldt_min[si],(lstklen+u8087len)/16 ;8087 user
mov ldt_max[si],(lstklen+u8087len)/16 ;96 byte extension
jmp cont_uda
form_uda: mov ldt_min[si],(lstklen+ulen)/16 ;min=max=UDA+STK paragraphs
mov ldt_max[si],(lstklen+ulen)/16
cont_uda: mov ax,lod_pd ! mov ldt_pd[si],ax
mov ldt_atr[si],mf_load
add si,ldtlen
inc lod_nldt
cmp lod_chain,true ! jne gc_ifo
;We are CHAINING. Free all memory
; except UDA area and LDSTK. This will keep
; the first partition for the chain
; as well as not crash the system.
push si
mov cx,f_freeall ! call osif
;transfer memory to new pd
mov bx,rlr
mov ax,p_mem[bx] ! mov p_mem[bx],0
mov bx,lod_pd ! mov p_mem[bx],ax
pop si
gc_ifo:
;go through CMD header and init
;a ldtab entry per header entry.
;alloc abs mem
mov bx,offset lod_dma
mov al,ch_lbyte[bx] ; save fixup flag
mov lod_lbyte,al
mov ax,ch_fixrec[bx] ; save record # of fixups, if any
mov lod_fixrec,ax
mov lod_fixrec1,ax
mov cx,ch_entmax ; BX = offset LOD_DMA
mov dx,8 ; DX = position in file
ch_more:cmp ch_form[bx],0 ! jne ch_doit
jmp ch_next
ch_doit: mov al,ch_form[bx] ! mov ldt_type[si],al ;type of seg
mov ax,ch_length[bx] ! mov ldt_flen[si],ax ;length
mov ldt_fstrt[si],dx ! add dx,ax ;pos in file
mov ax,ch_base[bx] ! mov ldt_start[si],ax ;abs seg
mov ax,ch_min[bx] ! mov ldt_min[si],ax ;min needed
mov ax,ch_max[bx]
cmp ax,0 ! jne setmax
mov ax,ch_min[bx]
setmax: mov ldt_max[si],ax ;max wanted
mov ax,lod_pd ! mov ldt_pd[si],ax ;pd to alloc to
cmp ax,0 ! je not_load
mov ax,mf_load
jmps not_load
skipjmp:jmps ch_more
;if mpm
not_load: cmp ch_form[bx],1 ! jne try_sh
add ax,mf_code ! jmps s_atr
try_sh: cmp ch_form[bx],9 ! jne s_atr
add ax,mf_code+mf_share
s_atr: mov ldt_atr[si],ax ;memory flags
;if abs, allocate memory
cmp ldt_start[si],0 ! je ch_nabs ;see if abs mem
jmps ch_al
ch_nabs: cmp ldt_type[si],9
jne ch_nxt ;see if shared code
push cx
push bx ! push dx ;save load DMA and position in file
call get_sh
pop dx ! pop bx
cmp cx,0 ! pop cx
je ch_nxt
jmp ld_out
ch_al: push bx ! push dx ! push cx ! push si
mov cx,f_malloc ! mov dx,si
call osif ! pop si
mov ax,ldt_start[si] ! mov ldt_id[si],ax
cmp cx,0 ! pop cx ! pop dx ! pop bx
je ch_nxt
;couldn't find memory
mov bx,0ffffh ! mov cx,e_no_memory
jmp ld_out
;endif
;if ccpm
;not_load: cmp ch_form[bx],9 ! jne try_code
; mov ch_form[bx],1
; mov ldt_type[si],1
;try_code: cmp ch_form[bx],1 ! jne s_atr
; add ax,mf_code
;s_atr: mov ldt_atr[si],ax ;memory flags
;
; ;if abs, allocate memory
; cmp ldt_start[si],0 ! je ch_nxt ;see if abs mem
;ch_al: push bx ! push dx ! push cx ! push si
; mov cx,f_malloc ! mov dx,si
; call osif ! pop si
; mov ax,ldt_start[si] ! mov ldt_id[si],ax
; cmp cx,0 ! pop cx ! pop dx ! pop bx
; je ch_nxt
; ;couldn't find memory
; mov bx,0ffffh ! mov cx,e_no_memory
; jmp ld_out
;
;endif
ch_nxt: add si,ldtlen
inc lod_nldt
ch_next:add bx,chlen
loop skipjmp
; alloc all other memory
; SI -> mpb for non_abs mem req.
;add all parts together for a single malloc
mov bx,offset ldtab
mov cx,lod_nldt
mov lod_nrels,0
lt_more:cmp ldt_min[bx],0 ! je lt_next
cmp ldt_start[bx],0 ! jne lt_next
mov ax,ldt_min[bx]
mov dx,ax
add ldt_min[si],ax
cmp dx,ldt_min[si] ! jbe lt_m ; check for ovrflw
mov ldt_min[si],0ffffh
lt_m: mov ax,ldt_max[bx]
mov dx,ax
add ldt_max[si],ax
cmp dx,ldt_max[si] ! jbe lt_m1 ; check for ovrflw
mov ldt_max[si],0ffffh
lt_m1: inc lod_nrels
lt_next:add bx,ldtlen ! loop lt_more
;malloc
cmp lod_pd,0 ! je noloadf
mov ldt_atr[si],mf_load
noloadf:mov ax,lod_pd ! mov ldt_pd[si],ax
push si ! mov dx,si ! mov cx,f_malloc
call osif ! pop si
mov ax,ldt_start[si] ! mov ldt_id[si],ax
cmp bx,0ffffh ! jne lt_sprd
;Not Enough Memory - release any
; memory already allocated
ld_out: push cx
mov bx,offset ldtab
mov cx,lod_nldt ! inc cx
lg_more: cmp ldt_id[bx],0 ! je lg_next
push cx ! push bx ! push ds
;push MFPB on stack
push ldt_pd[bx]
push ldt_id[bx]
mov dx,sp ! push ss ! pop ds
mov cx,f_memfree
call osif
pop cx ! pop cx
pop ds ! pop bx ! pop cx
lg_next: add bx,ldtlen ! loop lg_more
mov bx,0ffffh ! pop cx ! jmp lod_exit
lt_sprd:
;spread the memory allocated
;amongst the nrels
;1st give everyone the minimum
mov bx,offset ldtab
mov cx,lod_nldt
ls_more:cmp ldt_start[bx],0 ! jne ls_next
mov ax,ldt_min[bx]
sub ldt_min[si],ax
cmp ax,ldt_max[bx] ! jne ls_next
mov dx,ldt_start[si] ! mov ldt_start[bx],dx
add ldt_start[si],ax
dec lod_nrels
ls_next:add bx,ldtlen ! loop ls_more
;spread whats left amongst those that need more
mov bx,offset ldtab
mov cx,lod_nldt
lsl_mre:cmp ldt_start[bx],0 ! jne lsl_nxt
mov ax,ldt_start[si] ! mov ldt_start[bx],ax
mov ax,ldt_min[si]
cmp ax,0 ! je adj_start
push cx ! sub cx,cx
mov dx,cx ! mov cl,lod_nrels
div cx ! pop cx
cmp dx,0 ! je evendiv
inc ax
evendiv: mov dx,ldt_max[bx] ! sub dx,ldt_min[bx]
cmp ax,dx ! jbe nottoomuch
mov ax,dx
nottoomuch: add ldt_min[bx],ax ! sub ldt_min[si],ax
adj_start: mov ax,ldt_min[bx] ! add ldt_start[si],ax
dec lod_nrels
lsl_nxt:add bx,ldtlen ! loop lsl_mre
; fill memory from file
mov si,offset ldtab
mov cx,lod_nldt
lf_mre: cmp ldt_flen[si],0 ! je lf_nxt
push cx ! push ldt_start[si] ! push si
call lod_group
pop si ! pop ldt_start[si]
cmp cx,0 ! pop cx
je lf_nxt
;if ccpm
;
; jmp ld_out
;endif
;if mpm
; error in lod_group
; if loading shared code we also
; have to release Shared Code from SCL.
; It will be the top item in the list.
cmp ldt_atr[si],mf_load+mf_code+mf_share
je rm_sh
jmp ld_out
rm_sh: push cx ; remember Err Code
; Remove PD from SCL
pushf ! cli
mov bx,scl
mov ax,p_thread[bx]
mov scl,ax
popf
; Release the memory
push ds ! push bx
mov bx,p_mem[bx] ! push ms_start[bx]
mov ax,ss ! mov ds,ax
mov dx,sp ! mov cx,f_memfree
call osif
pop ax ! pop bx ! pop ds
; Place PD on PUL
pushf ! cli
mov ax,pul
mov pul,bx
mov p_link[bx],ax
popf
pop cx
jmp ld_out
;endif
lf_nxt: add si,ldtlen ! loop lf_mre
; Check for fixup records and do fixups
test lod_lbyte,80h ; hi bit of last byte in cmd header
jz init_base ; is set if fixups
fx_read:
mov ax,lod_fixrec ; get record # of fixups in file
mov bx,1 ; read one record
mov cx,ds
mov dx, offset lod_dma
call drd ; do random read
jcxz fx_read_ok ; 0=ok,CL=0ff if EOF
inc cl ; EOF ?
jnz fx_err ; some read error, not EOF
mov ax,lod_fixrec1 ; make sure one fixup
cmp ax,lod_fixrec ; record was read since cmd header
je fx_err ; said we needed them
jmps init_base
fx_read_ok: ; go look for fixup records
mov bx,offset lod_dma ; BX-> at fixup records
fx_chk:
mov al,fix_grp[bx] ; any more fixups?
test al,al
jz init_base
and al,0fh ; low nibble is target group
call tblsrch ; find target group in load table
mov dx,ldt_start[di] ; DX = target segment, this is
; what we add to the load image
mov al,fix_grp[bx] ; location group is high nibble
mov cl,4 ; put in low nibble of AL
shr al,cl
call tblsrch ; DI = location load table entry
mov ax,ldt_start[di] ; AX = base segment of location
add ax,fix_para[bx] ; add paragraph offset
push es ; absolute paragraph in memory
mov es,ax
xor ax,ax
mov al,fix_offs[bx] ; get offset of fixup location
mov di,ax
add es:[di],dx ; make the fixup (finally)
pop es
add bx,fixlen ; do next fixup
cmp bx,offset lod_dma + dskrecl ; end of this record ?
jne fx_chk
inc lod_fixrec ; read another record
jmps fx_read ; of fixups
tblsrch:
;-------
; Search for group in load table
; entry: AL = group # to match on
; exit: DI = load group entry that matches or
; pop return and exit loader
; BX,DX preserved
mov cx,lod_nldt ; # entries in table
mov di,offset ldtab
srchloop:
cmp al,ldt_type[di]
je srchdn ; found group's entry
add di,ldtlen
loop srchloop
pop ax
jmps fx_err
srchdn:
ret
fx_err:
mov cx,e_fixuprec
jmp ld_out
; init Base Page
; 1st Data Group has Base Page
; if none then first nonshared
; Code Group (8080 model)
init_base:
mov lod_8080,0
mov si,offset ldtab
mov cx,lod_nldt
lb_more:cmp ldt_type[si],2 ! je lb_fnd
add si,ldtlen ! loop lb_more
mov si,offset ldtab
mov cx,lod_nldt
lbc_mre: cmp ldt_type[si],1 ! je lb_fnd80
add si,ldtlen ! loop lbc_mre
mov cx,e_no_cseg ! jmp ld_out
lb_fnd80: mov lod_8080,1
lb_fnd:
push es ! mov es,ldt_start[si]
mov lod_basep,es
sub ax,ax ! mov di,ax
mov cx,05bh/2 ! rep stos ax
mov al,lod_8080 ! mov es:.5,al
mov si,offset ldtab
mov cx,lod_nldt
lbb_mre:cmp ldt_type[si],0 ! je lbb_nxt
mov ax,6 ! mov bl,ldt_type[si]
cmp bl,9 ! jne lbb_nsh
mov bl,1
lbb_nsh: dec bl ! mul bl ! mov bx,ax
;calculate last byte (3 byte value)
; =(paragraphs*16)-1
push cx ! mov dx,ldt_min[si]
push dx ! mov cl,4 ! shl dx,cl
push dx ! dec dx ! mov es:[bx],dx
pop cx ! pop dx ! push cx
mov cl,12 ! shr dx,cl ! pop cx
cmp cx,0 ! jne lbb_nzer
cmp dx,0 ! je lbb_zer
dec dl ! jmps lbb_nzer
lbb_zer: mov es:word ptr [bx],0
lbb_nzer: mov es:2[bx],dl ! pop cx
;put starting paragraph in place
mov ax,ldt_start[si] ! mov es:3[bx],ax
lbb_nxt:add si,ldtlen ! loop lbb_mre
;if 8080 model, copy CS info into DS info
cmp lod_8080,1 ! jne lnot80
push ds ! push es ! pop ds ! mov si,0
mov di,6 ! mov cx,3
rep movsw ! pop ds
lnot80:
mov al,lod_fifty ;initialize base page load disk
mov es:.50H,al
pop es
; init PD ,UDA and LDSTK
mov bx,lod_basep
cmp lod_pd,0 ! jne lip_1
jmp lod_exit
lip_1: mov si,offset ldtab
mov bx,lod_pd
; if 8087 user, flag it
cmp lod_ndp, 0
jz lip_2
cmp lod_ndp, 1
jnz true_87
or p_sflag[bx],psf_em87
jmp lip_2
true_87:
or p_flag[bx],pf_8087
lip_2:
;if it requires suspend mode, flag it
cmp lod_suspnd,0ffh
jnz lip_3
or p_sflag[bx],psf_suspend
lip_3:
mov ax,ldt_start[si]
mov p_uda[bx],ax
; remember where lstk,uda are
mov lod_uda,ax
push es ! mov es,ax
; if 8087 user, use long uda
cmp lod_ndp,0
jz shrt_uda
cmp lod_ndp,1
jz med_uda
add ax,(u8087len/16) ! jmp inter_uda ; full 8087 user, long uda
med_uda: add ax,(em87len/16) ! jmp inter_uda ; uses 87 emulator,medium uda
shrt_uda: add ax,(ulen/16) ; no 8087 activity,short uda
inter_uda: mov lod_lstk,ax
; initialize UDA,LDSTK with zeros
xor di,di ! mov ax,di
; if 8087 user, use long uda
cmp lod_ndp,0
jz shrt_uda1
; if 8087 emulator user, use medium uda
cmp lod_ndp,1
jnz long_uda1
mov cx,(em87len + lstklen)/2 ! jmp inter_uda1
long_uda1:
mov cx,(u8087len + lstklen)/2 ! jmp inter_uda1
shrt_uda1: mov cx,(ulen + lstklen)/2
inter_uda1: rep stos ax ! pop es
; setup p_uda for creat_proc
mov ax,sysdat
sub p_uda[bx],ax
mov p_stat[bx],ps_run
mov p_prior[bx],200
; init load disk/user
mov al,lod_user ! mov p_luser[bx],al
mov al,lod_disk ! mov p_ldsk[bx],al
; init UDA
push es ! mov es,lod_uda
mov u_dma_ofst,(offset bpg_dma)
mov bx,lod_basep
mov u_dma_seg,bx
mov ax,lod_lstk
cmp lod_ndp,0ffh ; if 8087 user, init control word for
jnz not_8087 ; first dispatch's frstor
mov u_8087, controlw ; 03ffh = post-init 8087 state
push ax
mov ax,sysvec87_of
mov u_ivec87_of,ax
mov ax,sysvec87_sg
mov u_ivec87_sg,ax
pop ax
not_8087:
push ds ! mov ds,bx
mov u_initds,bx
mov u_inites,bx
mov u_initss,ax
mov ax,bpg_cseg
cmp ax,0 ! jne h_cs
pop ds ! pop es ! mov cx,e_no_cseg
jmp ld_out
h_cs: mov u_initcs,ax
mov ax,bpg_eseg
cmp ax,0 ! je noes
mov u_inites,ax
noes: mov u_stack_sp,(offset ls_sp)
sub dx,dx ! mov al,bpg_8080
cmp al,0 ! je n80m
mov dx,0100h
n80m:
mov ds,u_initss
mov ls_offset,dx ;set up initial stack
mov ls_flags,0200h ;for a RETF from user
mov ls_roffset,offset user_retf ;process, see SUPIF.SUP
mov ls_rcseg,cs ;module for USER_RETF:
pop ds ! pop es ;code
mov bx,lod_basep
sub cx,cx
lod_exit:
push cx ! push bx
mov cx,f_qwrite ! mov dx,offset mxloadqpb
call osif ! pop bx ! pop cx ! ret
lod_group: ;load a group described in ldtab
;----------
; input: SI = addr of ldtab entry
; output: CX = Error Code
; see if first part already in DMA
mov bx,si
mov ax,lod_indma ;starting paragraph in dma
mov cx,ldt_fstrt[bx]
;AX = starting paragraph in local DMA
;CX = starting paragraph to transfer
;BX -> ldtab entry
cmp cx,ax ! jb rd_first
;starts at or after the pp. in dma
sub cx,ax
cmp cx,8 ! jae rd_first
;starts in the dma
mov dx,8 ! sub dx,cx
;CX = # of pp. to skip
;DX = length of remaining buffer
cmp dx,ldt_flen[bx] ! jbe xfer
mov dx,ldt_flen[bx]
xfer: mov si,offset lod_dma
mov ax,cx ! mov cl,4 ! shl ax,cl
add si,ax
;SI -> beginning of transfer area
; in lod_dma
mov ax,dx ! mov cl,3 ! shl ax,cl
mov cx,ax
;CX = number of words to transfer
xor di,di
push es ! mov es,ldt_start[bx]
rep movsw ! pop es
add ldt_start[bx],dx
sub ldt_flen[bx],dx ! add ldt_fstrt[bx],dx
rd_first:
cmp ldt_flen[bx],0 ! jne rd_1st
sub cx,cx ! ret
rd_1st:
test ldt_fstrt[bx],07h ! jnz rd_indma
cmp ldt_flen[bx],8 ! jae xf_d
rd_indma:
push bx
mov ax,ldt_fstrt[bx]
shr ax,1 ! shr ax,1 ! shr ax,1 ; Record #
mov bx,1 ; read 1 record
mov dx,offset lod_dma ; DMA offset
mov cx,sysdat ; DMA segment
call drd
pop bx
jcxz rd_agn
cmp cx,0ffh ! jne rd_r3
mov cx,0
rd_r3: ret
rd_agn: mov ax,ldt_fstrt[bx]
and ax,0fff8h ; note starting paragraph
mov lod_indma,ax ; in DMA
mov si,bx ! jmp lod_group
; We are at a Sector Boundary with at least
; a sector to place into the user area
xf_d:
push bx
sub dx,dx ; DMA offset
mov cx,ldt_start[bx] ; DMA segment
mov ax,ldt_fstrt[bx]
shr ax,1 ! shr ax,1 ! shr ax,1 ; Record #
mov bx,ldt_flen[bx]
shr bx,1 ! shr bx,1 ! shr bx,1 ; # of records
push bx
call drd
pop ax ! pop bx
jcxz xfer_n
cmp cx,0ffh ! jne rd_r4
xor cx,cx
rd_r4: ret
xfer_n: shl ax,1 ! shl ax,1 ! shl ax,1
add ldt_start[bx],ax
add ldt_fstrt[bx],ax
sub ldt_flen[bx],ax
jmp rd_first
drd:
; input: AX = Record Number
; BX = Number of Sectors
; CX = dma segment
; DX = dma offset
; output: CX = 0 if okay
; CX = 0FFH if End of File
; else Error Code
mov u_dma_ofst,dx
mov u_dma_seg,cx
; read BX sectors starting at Record AX
drd_lp:
push bx ;old # sectors
push ax ;old record #
cmp bx,128 ! jbe drd_r
mov bx,128
; Max Mulit-sector count is 128
drd_r: mov cl,u_mult_cnt
push cx
mov u_mult_cnt,bl
push bx
mov si,offset lod_fcb
mov fcb_r0[si],ax
mov cx,f_freadrdm ! mov dx,si
push es ! call osif ! pop es
pop dx ;multi_cnt used
pop cx ! mov u_mult_cnt,cl
cmp bl,1 ! jbe dr_r2
mov cx,e_bad_read ! mov bx,0ffffh
pop ax ! pop ax ! ret
dr_r2: mov cl,bl
xor bh,bh ! mov di,bx ;save BL for header read check
pop ax ! add ax,dx ;adjust record #
pop bx ! sub bx,dx ;adjust # sectors
shl dx,1 ! shl dx,1 ! shl dx,1
add u_dma_seg,dx
; check for CTRL C. If hit while loading
; last set of characters, this is the place to
; clean things up...
push cx ! push ax ! push bx ! push di
mov cx,f_ciostat ! call osif
pop di ! pop bx ! pop ax ! pop cx
; Now see if CTRL C was hit during the
; the load.
mov si,rlr
test p_flag[si],pf_ctlc ! jz dr_r1
mov cx,e_abort ! mov bx,0ffffh
ret
dr_r1: cmp cl,0 ! je dr_r5
mov cx,0ffh ! ret
dr_r5: cmp bx,0 ! jne dr_r6
xor cx,cx
ret
dr_r6: jmp drd_lp
;if mpm
get_sh:
;------
; Allocate memory for shared code. If memory already
; exists then mark LDTAB entry with FLEN=0 for no load.
; START must be non-zero on success.
;
; input: SI = LDTAB Entry for shared code
; output: CX = 0 on success
; = 0ffffh on failure
; SI is unchanged
;
; 1. Look for PD Name on SCL, making sure
; LDSK and LUSER are the same.
mov bx,(offset scl)-p_thread
gs_nxt: push si
mov dx,offset lod_fcb ! add dx,fcb_name
mov cx,f_findpdname ! call osif
; BX=pd found or 0ffffh
pop si
cmp bx,0ffffh ! je no_sh
mov al,lod_disk
cmp p_ldsk[bx],al ! jne gs_nxt
mov al,lod_user
cmp p_luser[bx],al ! jne gs_nxt
; 2. if (1.) then Share the Memory.
; 2.1 Set FLEN=0
push bx ! push si
call shmem
pop si ! pop bx
cmp cx,0ffffh ! je no_sh
mov ldt_flen[si],0
; Put SHARE PD on end of SCL
; BX = SHARE PD
pushf ! cli
mov di,(offset SCL)-p_thread
sh_nin1: cmp p_thread[di],bx ! je sh_rm ;look for share PD
mov di,p_thread[di] ! jmps sh_nin1
sh_rm: mov ax,p_thread[bx] ;take it off the list
mov p_thread[di],ax
sh_in: cmp p_thread[di],0 ! je sh_end ;look for the end
mov di,p_thread[di] ! jmps sh_in
sh_end: mov p_thread[di],bx ;insert share PD on end
xor cx,cx
mov p_thread[bx],cx
popf ! ret ;success
; 3. if (NOT 1.) allocate memory to NEW PD
no_sh:
; get new PD
pushf ! cli
mov bx,pul
cmp bx,0 ! je sherr
mov ax,p_link[bx] ! mov pul,ax
popf
; alloc memory for code segment
push bx ! push si
mov cx,f_malloc
mov dx,si
call osif
pop si ! pop bx
cmp cx,0 ! jne merr
; initialize new PD name
; BX = New PD
push si
mov si,ldt_pd[si] ;SI=old pd
push si
mov di,bx
add si,p_name ! add di,p_name
mov cx,4
push es ! mov ax,ds ! mov es,ax
rep movsw
pop es ! pop di ! pop si
; DI = old PD, BX=New PD
mov al,lod_user ! mov p_luser[bx],al
mov al,lod_disk ! mov p_ldsk[bx],al
; share w/new PD
mov ax,ldt_start[si]
push bx ! push si ! push ds
push ax ! push bx ! push di
mov ax,ss ! mov ds,ax
mov dx,sp ! mov cx,f_share
call osif
add sp,6
pop ds ! pop si ! pop bx
; put new PD on SCL
pushf ! cli
mov di,(offset SCL)-p_thread
sh_nin: cmp p_thread[di],0 ! je sh_doit
mov di,p_thread[di] ! jmps sh_nin
sh_doit: mov p_thread[di],bx ;insert new share PD
xor cx,cx
mov p_thread[bx],cx
popf ! ret ;success
merr: pushf ! cli
mov ax,pul
mov p_link[bx],ax
mov pul,bx
sherr: popf
mov cx,0ffffh ! ret
shmem:
;-----
;input: SI = LDTAB
; BX = Owner PD
; Load_pd = Requestor
; Have to set LDT_START
;
lea di,(p_mem-ms_link)[bx]
sm_nxt:
mov di,ms_link[di]
cmp di,0 ! je sm_no
mov ax,ms_flags[di]
and ax,mf_share+mf_code+mf_load
cmp ax,mf_share+mf_code+mf_load ! jne sm_nxt
push si ! push ds
push ms_start[di]
push ms_start[di]
push lod_pd
push bx
mov ax,ss ! mov ds,ax
mov dx,sp ! mov cx,f_share
call osif
; This will always work.
pop ax ! pop ax ! pop ax
pop dx ! pop ds ! pop si
mov ldt_start[si],dx
ret
sm_no: mov cx,0ffffh ! ret


19
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/LSTK.FMT Normal file
View File

@@ -0,0 +1,19 @@
;*****************************************************
;*
;* Load Stack Format
;*
;*****************************************************
lstklen equ 96 * byte
DSEG
org lstklen - 10
ls_sp rw 0
ls_offset rw 1
ls_cseg rw 1
ls_flags rw 1
ls_roffset rw 1
ls_rcseg rw 1


303
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/MAU.MEM Normal file
View File

@@ -0,0 +1,303 @@
;*****************************************************
;*
;* Memory Allocation Unit Routines
;*
;* Memory Allocation Unit
;* A Memory Allocation Unit is a contiguous
;* area of memory that is described by a MD.
;* At the beginning of this area is a Suballocation
;* table that describes areas within it that are
;* allocated or free
;*
;* +----+----+----+----+----+----+----+----+
;* MD | Link | Start | Length | Plist |
;* +----+----+----+----+----+----+----+----+
;*
;* Link - Link field for placing MAUs on Linked
;* lists
;* Start - Segment Address of the area covered
;* Length - Length of area
;* Plist - used for a linked list of partitions
;* that are included in this area.
;*
;* Suballocation Table
;* The m_start field is the segment
;* address of the suballocation table (offset 0).
;* The first entry of the table is special and
;* has the following format.
;*
;* +----+----+----+----+----+
;* SAT0 |ents| reserved |
;* +----+----+----+----+----+
;*
;* sat1_ents - number of SAT entries
;* not including SAT0
;* Subsequent entries have the following format
;*
;* +----+----+----+----+----+
;* SAT | Start | Length |nall|
;* +----+----+----+----+----+
;*
;* start - start address of this contiguous
;* piece of memory
;* length - of this piece of memory
;* nall - number of times allocated
;* 0 = free 2 = share
;*
;*****************************************************
sat_start equ word ptr 0
sat_length equ word ptr sat_start + word
sat_nall equ byte ptr sat_length + word
satlen equ sat_nall + byte
;==============
maualloc_entry: ; Alloc from MAU
;==============
; Allocate a piece of memory from an MAU
;
; input: BX = address of MAU
; DX = MPB in u_wrkseg
; mpb_start = abs addr (0 = any)
; mpb_min = minimum necessary
; mpb_max = maximum wanted
;
; output: BX = 0h if success
; 0ffffh if failure
; CX = Error Code
; mpb_start = start address
; mpb_min = mcb_max = length
push es ! mov es,u_wrkseg
; if absolute, see if within MAU
mov si,dx ! mov cx,es:mpb_start[si]
cmp cx,0 ! je maua_rel
mov ax,m_start[bx]
cmp cx,ax ! jb maua_err
add ax,m_length[bx]
cmp cx,ax ! jae maua_err
maua_rel:
mov ds,m_start[bx]
maua_start:
sub bx,bx ! mov dl,bl ;BX->SAT entry
;DL = SAT number
maua_nsat:
inc dl ! add bx,satlen
cmp dl,.0 ! ja maua_err ;?out of table entries?
cmp sat_start[bx],0 ! je maua_err ;?end of used table?
cmp sat_nall[bx],0 ! jne maua_nsat ;?already allocated?
mov cx,es:mpb_start[si]
cmp cx,0 ! je maua_nabs ;?abs req?
mov ax,sat_start[bx]
cmp cx,ax ! jb maua_nsat ;?in this area?
add ax,sat_length[bx]
cmp cx,ax ! jae maua_nsat
cmp cx,sat_start[bx] ! je maua_nabs ;?exact?
sub cx,sat_start[bx]
push si
call mau_split ;make exact
pop si
jmps maua_start
maua_err:
mov bx,0ffffh ! mov cx,e_no_memory
jmps maua_out
maua_nabs:
mov cx,es:mpb_min[si]
mov ax,sat_length[bx]
cmp cx,ax ! ja maua_nsat
mov cx,es:mpb_max[si]
cmp cx,ax ! jae maua_alloc
cmp sat_nall[bx],0 ! je maua_splitit
mov ax,es:mpb_flags[si]
and ax,mf_share ! jz maua_nsat
jmps maua_alloc
maua_splitit: push si ! call mau_split ! pop si
maua_alloc: mov ax,sat_length[bx]
mov es:mpb_min[si],ax
mov es:mpb_max[si],ax
mov ax,sat_start[bx]
mov es:mpb_start[si],ax
inc sat_nall[bx]
call mau_collapse
sub bx,bx ! mov cx,bx
jmps maua_out
maua_out:
mov ds,sysdat
pop es ! ret
;=============
maufree_entry: ; Free from MAU
;=============
; free SAT in given MAU
; input: DX = address of MAF in u_wrkseg
; output: CX = 0 if successful
; CX = 0ffffh on failure
; if CX = 0,
; BX = 0 if MAU still in use
; BX = 0ffffh if MAU is empty
; if CX = 0ffffh
; BX = 0ffffh
push es ! mov es,u_wrkseg
mov si,dx
mov bx,es:maf_mau[si]
mov ds,m_start[bx]
; ES:SI -> MAF
; DS: 0 -> SAT table
sub bx,bx ! mov cx,bx
mov dx,es:maf_sat[si]
; DS:BX -> current SAT
; CX = SAT entry number
; DX = MAF_SAT start
mauf_nsat:
add bx,satlen ! inc cx
cmp cx,.0 ! ja mauf_err
cmp dx,sat_start[bx] ; This SAT?
jne mauf_nsat
cmp dx,es:maf_start[si] ; Freeing all of it?
je mauf_free
cmp sat_nall[bx],1 ; Is it shared?
je mauf_nsha
jmps mauf_out ; Can't split it
; since its shared.
; But, no error
mauf_nsha: mov cx,es:maf_start[si] ; Not shared,
mov ax,sat_start[bx]
add ax,sat_length[bx]
cmp ax,cx ! jb mauf_err ; Within range?
; must split this SAT
; this can only be done if not shared
sub cx,dx ! call mau_split
sub cx,cx ! mov bx,cx ! jmps mauf_c
mauf_free: dec sat_nall[bx]
mauf_c: call mau_collapse ! jmps mauf_out
mauf_err:
mov bx,0ffffh ! mov cx,e_no_memory
mauf_out:
pop es ! mov ds,sysdat
ret
mau_split: ;split SAT into 2
;--------- -----------------
; new SAT element starting at split boundary
; with nall=0, old has same nall.
; input: BX = address of SAT element
; CX = length to split at
; output: BX = address of original SAT element
push bx ! push cx
add bx,satlen ! call mau_insert
cmp cx,0 ! pop cx
pop bx ! jne maus_err ;create hole if error
lea di,satlen[bx] ! mov dx,sat_length[bx]
sub dx,cx ! mov sat_length[di],dx
mov dx,cx ! add dx,sat_start[bx]
mov sat_start[di],dx ! mov sat_nall[di],0
maus_err:
mov sat_length[bx],cx
ret
mau_collapse: ;collapse adjacent unallocated SATs
;------------ -----------------------------------
; collapse adjacent unallocated SATs and holes in table
; if possible
; return: BX = 0 if not empty
; = 0ffffh if empty
; CX = 0
sub bx,bx ! mov cx,bx
mauc_nsat:
inc cx
cmp cx,.0 ! je mauc_mtchk
add bx,satlen ! lea di,satlen[bx]
cmp sat_start[bx],0 ! je mauc_mtchk
cmp sat_start[di],0 ! je mauc_mtchk
cmp sat_nall[bx],0 ! jne mauc_notfree
;this SAT is free
mov ax,sat_start[bx] ! add ax,sat_length[bx]
cmp ax,sat_start[di] ! je mauc_fnohole
;followed by a hole
mov ax,sat_start[di] ! sub ax,sat_start[bx]
mov sat_length[bx],ax
mauc_fnohole:
;free SAT., no hole
cmp sat_nall[di],0 ! jne mauc_nsat
;followed by free SAT
mov ax,sat_length[di]
add sat_length[bx],ax
push bx ! push cx
mov bx,di ! call mau_release
pop cx ! pop bx
sub bx,satlen ! dec cx
jmp mauc_nsat
mauc_notfree:
;allocated SAT
mov ax,sat_start[bx] ! add ax,sat_length[bx]
cmp ax,sat_start[di] ! je mauc_nsat
;followed by a hole
cmp sat_nall[di],0 ! je mauc_nfhole
;next SAT is allocated
push bx ! push cx
mov di,bx ! call mau_insert
pop cx ! pop bx
jmp mauc_nsat
mauc_nfhole: ;Alloc SAT, followed by hole
;next SAT is free
mov ax,sat_start[di] ! sub ax,sat_start[bx]
sub sat_start[di],ax ! add sat_length[di],ax
jmp mauc_nsat
mauc_mtchk:
mov bp,0ffffh
xor cx,cx ! xor bx,bx
mauc_mtn:
inc cx
cmp cx,.0 ! je mauc_out
add bx,satlen
cmp sat_start[bx],0 ! je mauc_out
cmp sat_nall[bx],0 ! je mauc_mtn
mov bp,0
mauc_out:
mov bx,bp ! xor cx,cx ! ret
mau_release:
;-----------
; input: BX = SAT to release
push es ! mov ax,ds ! mov es,ax
mov ax,satlen
mul byte ptr .0
push ax ! mov cx,ax ! sub cx,bx
mov di,bx ! add bx,satlen
mov si,bx ! rep movs al,al
pop bx ! mov sat_length[bx],0
mov sat_start[bx],0
mov sat_nall[bx],0
pop es ! ret
mau_insert:
;----------
; input: BX = SAT to place new SAT in front
; output: CX = 0 if successful
mov ax,satlen ! mul byte ptr .0
mov si,ax ! mov cx,0ffffh
cmp sat_start[si],0 ! jne maui_r
mov cx,si ! sub cx,bx
dec si ! lea di,satlen[si]
push es ! push ds ! pop es
std ! rep movsb ! cld
pop es ! sub cx,cx
mov sat_start[bx],cx
mov sat_length[bx],cx
mov sat_nall[bx],cl
maui_r: ret


30
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/MEM.A86 Normal file
View File

@@ -0,0 +1,30 @@
include cpyright.def
;*****************************************************
;*
;* MP/M-86 Memory Management Module
;*
;*****************************************************
eject ! include system.def
eject ! include modfunc.def
eject ! include pd.def
eject ! include qd.def
eject ! include err.def
eject ! include mem.def
eject ! include mpb.def
eject ! include uda.def
eject ! include memif.mem
eject ! include cpmmem.mem
eject ! include memory.mem
eject ! include share.mem
eject ! include mau.mem
eject ! include ml.mem
eject ! include util.mem
eject ! include patch.cod
eject ! include uda.fmt
eject ! include lstk.fmt
eject ! include sysdat.dat
eject ! include data.bdo
eject ! end


BIN
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/MEMIF.MEM Normal file
View File

Binary file not shown.

480
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/MEMORY.MEM Normal file
View File

@@ -0,0 +1,480 @@
;*****************************************************
;*
;* MEM Entry Points
;*
;* Each process descriptor points to a linked
;* list of MDs that describe memory segments that
;* it owns. The MDs note the starting paragraph
;* and a MAU that the Memory Segment is in.
;*
;* Format of MDs on p_mem lists:
;*
;* +----+----+----+----+----+----+----+----+----+----+
;* | link | start | length | flags | mau |
;* +----+----+----+----+----+----+----+----+----+----+
;*
;* link link field for p_mem list
;* start starting paragraph of memory segment
;* length length in paragraphs of memory segment
;* flags load,code,and share as in MPB
;* mau offset of MAU in SYSDAT that segment is
;* allocated from
;*
;*****************************************************
;============
malloc_entry:
;============
; Allocate Memory - memory is allocated from MAUs.
; First we try to allocate memory from MAUs that has
; memory segments already allocated by this process.
; If that fails, we try to create a new MAU from the
; Memory Free List (MFL). If both fails, an error is
; is returned to the user.
;
; input: DX = MPB in u_wrkseg
; output: BX = 0 if successful (unused memory)
; = 1 if successful (shared code)
; = 0ffffh if failure
; CX = error code
;
; Format of MPB:
;
; +----+----+----+----+----+----+----+----+----+----+
; | start | min | max | pdadr | flags |
; +----+----+----+----+----+----+----+----+----+----+
;
; start - if non-zero, an absolute request
; min - minimum length that will satisfy the request
; max - maximum length wanted
; We will try to allocate the maximum
; but will be satisfied with as little as the
; minimum.
; pdadr - Process Descriptor to allocate memory to.
; Note - PD can not be a current process unless
; it is the calling process.
; The Calling process must explicitly release
; the memory if the PD never becomes a process.
; Otherwise, memory is released upon termination.
; If pdadr is 0, then calling process allocates
; the memory.
; flags - 00001h Load This segment initialized from
; a disk file
; 00002h Shared This is a sharable segment
; 00004h Code This is a Code segment
; Get a MD for use in the p_mem list
; DX -> MPB (u_wrkseg)
push dx ! call getmd ! pop dx ; BX -> MD
jcxz mall_gmd
mov bx,0ffffh ! ret
mall_gmd:
; fill PDADR field in case its zero
push es ! mov es,u_wrkseg ;save UDA
mov di,dx ! mov ax,es:mpb_pdadr[di]
cmp ax,0 ! jne mall_gpd
mov ax,rlr
mov es:mpb_pdadr[di],ax
mall_gpd:
pop es ;ES=UDA
cmp ax,rlr ! je mall_pdv1
push ax ! push bx
push dx ! push di
mov bx,offset thrd_spb ;ok to call sync on
mov cx,f_sync ;thread after sync-ing
call osif ;on memory
pop di ! pop dx
pop bx ! pop ax
mov si,(offset thrdrt)-p_thread
mall_pdnxt: mov si,p_thread[si]
cmp si,0 ! je mall_pdver
cmp si,ax ! jne mall_pdnxt
cmp si,rlr ! je mall_pdver
mov cx,e_active_pd
push bx ; save MD addr
mov bx,offset thrd_spb
mov cx,f_unsync
call osif
pop bx ; restore MD addr
jmp mall_err
mall_pdver:
push ax ! push bx
push dx ! push di
mov bx,offset thrd_spb
mov cx,f_unsync
call osif
pop di ! pop dx
pop bx ! pop ax
; verify MIN <= MAX
mall_pdv1:
push es ! mov es,u_wrkseg
mov cx,es:mpb_min[di]
cmp cx,es:mpb_max[di]
jbe mpb_ok
mov es:mpb_max[di],cx
mpb_ok:
; Make sure total allocation <= MMP
mov si,ax ! add si,(p_mem - ms_link)
sub cx,cx ! push si
max_chk_nxt:
mov si,ms_link[si]
cmp si,0 ! je max_chk_done
add cx,ms_length[si]
jmps max_chk_nxt
max_chk_done:
pop si ! mov ax,mmp
sub ax,cx
cmp ax,0 ! jne not_zero
no_min: pop es
mall_nomem: mov cx,e_no_memory
mall_err: call freemd ; Free the Memory Descriptor
mov bx,0ffffh ! ret ; CX=Error Code set previously
not_zero:
cmp ax,es:mpb_min[di] ! jb no_min
cmp ax,es:mpb_max[di] ! jae max_ok
mov es:mpb_max[di],ax
max_ok:
; initialize local variables
push di ! mov di,offset beststart
mov cx,11 ! sub ax,ax
mov es,sysdat
rep stosw ! pop di
sub cx,cx
pop es
; try to allocate memory
mall_next:
mov si,ms_link[si]
cmp si,0 ! je mall_ml
cmp cx,ms_mau[si] ! je mall_next
; here's a MAU we haven't tried...
; CX=last MAU tried
; DX=MPB adr in u_wrkseg
; BX=New MD
; SI=current MD
push cx ! push dx ! push bx ! push si
mov bx,ms_mau[si]
call mall_try_mau
pop si ! pop bx ! pop dx
; Plus DI=MAU address
cmp cx,0 ! pop cx ! jne mall_next
; exact allocation
; succesful allocation
jmp mall_linkit
mall_ml: ; We must create a new MAU from MFL
push bx ! push dx
mov ds,u_wrkseg
mov bx,offset mfl ! mov cx,f_mlalloc
call osif
mov ds,sysdat
;BX=MAU, (New MD,MPB on stack)
jcxz mall_ml0
pop dx ! pop bx
jmp mall_linkit
mall_ml0: ; We have a new MAU
;place MAU on MAL
mov si,mal
mov m_link[bx],si
mov mal,bx
;allocate memory
pop dx ! push dx
sub si,si
call mall_try_mau
pop dx ! pop bx
;DI=MAU, BX=New MD, DX=MPB in u_wrkseg
mall_linkit:
;BX -> MD
;DX -> MPB in u_wrkseg
cmp beststart,0 ! jne yesmem
;if ccpm
; jmp mall_nomem
;endif
;if mpm
; We couldn't find any memory ...
; lets take something off the SCL
pushf ! cli
mov di,scl
cmp di,0 ! jne take_one_off
; No where else to try, giveup.
popf ! jmp mall_nomem
; take first SHARE PD off SCL
take_one_off:
mov ax,p_thread[di]
mov scl,ax
popf
; Free its memory
; We can assume only one memory segment
push bx ! push dx
mov bx,p_mem[di]
push di ! push ds
push di ! push ms_start[bx]
push ss ! pop ds
mov dx,sp ! mov cx,f_memfree
call osif
pop ax ! pop ax
pop ds ! pop di
; There should be no error.
; Put SHARE PD on PUL
pushf ! cli
mov ax,pul
mov p_link[di],ax
mov pul,di
popf
; Let's assume we just released a partition
; and try the ML Alloc again.
pop dx ! pop bx
jmp mall_ml
;endif
; We have memory ...
yesmem:
push es ! mov es,u_wrkseg
mov di,dx
mov ax,beststart
mov es:mpb_start[di],ax
mov ms_start[bx],ax
mov ax,bestlen
mov es:mpb_min[di],ax
mov es:mpb_max[di],ax
mov ms_length[bx],ax
mov ax,es:mpb_flags[di]
mov ms_flags[bx],ax
mov si,bestsi
cmp si,0 ! jne mall_l0
mov si,es:mpb_pdadr[di]
add si,(p_mem-ms_link)
mall_l0:mov ax,ms_link[si] ! mov ms_link[bx],ax
mov ms_link[si],bx
mov di,bestmau
mov ms_mau[bx],di
pop es ! sub cx,cx ! mov bx,cx ! ret
mall_try_mau:
;------------
; input: BX -> MAU
; DX -> MPB in u_wrkseg
; SI = MS Root that MAU came from
; output: CX = 0, found exact allocation
; else, exact not found
; save root,mau
mov currsi,si
mov currmau,bx
; copy user's MPB into local MPB
push dx ! push ds ! push es
mov ds,u_wrkseg
mov es,sysdat
mov si,dx ! mov di,offset currmpb
mov cx,5 ! rep movsw
pop es ! pop ds
mov dx,offset currmpb
mov cx,f_maualloc ! call osif
pop di
jcxz chkbest
ret
chkbest:
push es ! mov es,u_wrkseg
mov si,offset currmpb
mov ax,mpb_max[si]
sub cx,cx
cmp ax,es:mpb_max[di]
pop es
jz replacebest
mov cx,3 ! mov bx,currmau
mov di,si
cmp ax,bestlen ! jbe freeworst
replacebest:
mov di,offset beststart
mov bx,bestmau
call freeworst
mov si,offset currmpb
mov ax,mpb_start[si] ! mov beststart,ax
mov ax,mpb_max[si] ! mov bestlen,ax
mov ax,currmau ! mov bestmau,ax
mov ax,currsi ! mov bestsi,ax
savret: ret
freeworst: ; DI->Start, CX=Return Code, BX=MAU
cmp word ptr [di],0 ! je savret
; free worst memory
push cx ! push ds
push word ptr [di] ! push word ptr [di]
push bx ! push ss ! pop ds
mov dx,sp ! mov cx,f_maufree
call osif
; if MAU empty, free MAU
cmp cx,0 ! jne mflret
cmp bx,0ffffh ! jne mflret
pop bx ! pop ax ! pop ax ! pop ds
; take off MAL
; BX = MAU address
mov ax,bx ! mov bx,(offset mal)-m_link
mfl1: mov si,bx ! mov bx,m_link[si]
cmp bx,ax ! jne mfl1
push ax
mov ax,m_link[bx] ! mov m_link[si],ax
pop bx
; Replace into MFL
mov cx,f_mlfree
mov dx,bx ! mov bx,offset mfl
call osif ! pop cx ! ret
mflret: pop bx ! pop ax ! pop ax
pop ds ! pop cx ! ret
;===========
mfree_entry: ; 130 - Memory Free
;===========
; Free the memory segment with the given segment addr.
; input: DX = MFPB in u_wrkseg
; output: BX = 0 if successful
; = 0ffffh on failure
; CX = error code
;
; Memory Free Parameter Block (MFPB)
;
; +----+----+----+----+
; | start | pdadr |
; +----+----+----+----+
;
; start - starting paragraph of area to be freed.
; pdadr - PD to free memory from. If 0, then calling
; process. If non-zero, the PD must not be
; a current process.
push es ! mov es,u_wrkseg
mov si,dx
mov bx,es:mfpb_pd[si]
mov dx,es:mfpb_start[si]
pop es
; BX = pdadr
; DX = start paragraph
cmp bx,0 ! jne mfree_chkpd
mov bx,rlr
jmps mfree_g1
mfree_chkpd:
push bx ! push dx
mov bx,offset thrd_spb
mov cx,f_sync
call osif
pop dx ! pop bx
mov si,(offset thrdrt)-p_thread
mfree_nxtpd:
mov si,p_thread[si]
cmp si,0 ! je mfree_gotpd
cmp si,bx ! jne mfree_nxtpd
cmp si,rlr ! je mfree_gotpd
mov bx,offset thrd_spb
mov cx,f_unsync
call osif
mov bx,0ffffh
mov cx,e_active_pd
ret
mfree_gotpd:
push bx ! push dx
mov bx,offset thrd_spb
mov cx,f_unsync
call osif
pop dx ! pop bx
mfree_g1:
lea si,p_mem[bx]
mfree_next:
mov bx,si ! mov si,ms_link[bx]
cmp si,0 ! je mfree_err
cmp ms_start[si],dx ! je mfree_it
ja mfree_next
mov ax,ms_start[si]
add ax,ms_length[si]
cmp ax,dx ! jbe mfree_next
push dx ! push si
call mfree_it
pop si ! pop dx
cmp cx,0 ! jne mfree_next
mfree_exit:
sub bx,bx ! mov cx,bx ! ret
mfree_err:
mov bx,0ffffh ! mov cx,e_no_memory
ret
mfree_it:
;--------
; input: BX = root
; SI = MD ([bx])
; DX = segment to free
; output: BX = 0,0ffffh (success,failure)
; CX = Error Code
push bx ! push si ! push dx
;push MAF structure
push dx ! push ms_start[si]
push ms_mau[si]
mov dx,sp ! push ss ! pop ds
mov cx,f_maufree ! call osif
mov bp,bx ;if bp=0,MAU not empty
mov ds,sysdat
;pop MAF structure
pop ax ! pop ax ! pop ax
pop dx ! pop si ! pop bx
;DX=segment to free
;BX=root
;SI=MD ( [BX] )
cmp cx,0
jne mfree_err
cmp dx,ms_start[si] ! je mfree_off
;decrease length
sub dx,ms_start[si]
mov ms_length[si],dx
mfree_r:
jmps mfree_exit
;take off p_mem list
mfree_off: mov ax,ms_link[si] ! mov ms_link[bx],ax
;free MD
push ms_mau[si] ! push bp
mov bx,si ! call freemd
pop bp ! pop dx
;free MAU if empty
cmp bp,0 ! je mfree_exit
;find it on MAL
mov di,(offset mal)-m_link
mfree_nmal: mov si,di ! mov di,m_link[si]
cmp di,dx ! jne mfree_nmal
;release from MAL
mov ax,m_link[di] ! mov m_link[si],ax
mov m_link[di],0
;release to MFL
mov bx,offset mfl ! mov cx,f_mlfree
jmp osif


223
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/ML.MEM Normal file
View File

@@ -0,0 +1,223 @@
;*****************************************************
;*
;* Memory List Functions
;*
;*****************************************************
;=============
mlalloc_entry: ; Alloc from Mem List
;=============
; Create a MAU from a Memory List. Memory List is a
; linked list of MDs in memory order (low first). It
; is assumed that units in the Memory List are paragraphs
; input: DX = address of MPB in u_wrkseg
; BX = ML root in SYSDAT
; output: BX = address of MAU
; = 0ffffh if error
; CX = Error Code
mov si,dx
sub ax,ax ! mov cx,ax ! mov dx,0ffffh
; AX = MD w/best score
; DX = best score
; CX = # partitions used
; SI -> MPB in u_wrkseg
push ax ! push cx
mla_nmd:cmp m_link[bx],0 ! je mla_found
push bx ! push dx ! push si
call mla_value
pop si ! pop dx ! pop bx
cmp cx,dx ! jae mla_next
mov dx,cx ! pop cx ! mov cx,ax
pop ax ! mov ax,bx
push ax ! push cx
cmp dx,0 ! je mla_found
mla_next: mov bx,m_link[bx]
jmps mla_nmd
mla_found:
pop cx ! pop ax
cmp ax,0 ! je mla_err
mov bx,ax ! mov ax,cx
jmp mla_makemau
mla_err:
mov bx,0ffffh ! mov cx,e_no_memory
mla_out:ret
mla_value:
;---------
; input: BX = ML element Root
; SI = MPB in u_wrkseg
; output: CX = value (0=perfect,0ffffh=no fit)
; AX = # of elements
xor bp,bp ; Func 129 repair, FMB, 1/20/84
push es ! mov es,u_wrkseg
sub ax,ax ! mov dx,0
; AX = # of partitions
; DX = total length so far
mov di,m_link[bx]
cmp di,0 ! je mlav_err
; we have a list
cmp es:mpb_start[si],0 ! je mlav_next
;an absolute request
mov cx,m_start[di] ! add cx,(2*satlen)
cmp es:mpb_start[si],cx ! jb mlav_err
;it starts after our start
add cx,m_length[di] ! sub cx,(2*satlen)
cmp es:mpb_start[si],cx ! jae mlav_err
; Func 129 repair, FMB, 1/20/84
mov bp,1 ; On an absolute request, the
inc ax ; current available length within
mov dx,cx ; the partition was not calculated
sub dx, es:mpb_start[si] ; correctly.
mov bx,di ;
mov di, m_link[bx] ;
;this list satisfies ABS requirement
mlav_next: mov cx,es:mpb_max[si]
cmp cx,dx ! jb mlav_chk
mlav_add: cmp ax,0 ! je mlav_ad1
push ax
mov ax,m_start[bx]
add ax,m_length[bx]
cmp ax,m_start[di] ! pop ax ! je mlav_ad1
jmps mlav_chkmin
mlav_ad1: inc ax ! add dx,m_length[di]
mov bx,di ! mov di,m_link[bx]
cmp di,0 ! jne mlav_next
mlav_chkmin: mov cx,es:mpb_min[si]
add cx,(2*satlen)
cmp cx,dx ! jbe mlav_calc
mlav_err: mov cx,0ffffh ! sub ax,ax
pop es ! ret
mlav_chk:
cmp bp,1 ! je mlav_calc ; Func 129 repair, FMB, 1/20/84
add cx,(2*satlen)
cmp cx,dx ! ja mlav_add
mlav_calc: ; HERE IS WHERE WE GIVE THIS SET A VALUE.
; IT CAN SATIFY THE REQUEST.
; ALGORITHM:
; #partitions = #partitions + 1 if next
; to contiquous memory
; value = (abs(max-length) SHR 4) +
; ((#partitions-1) SHL 2)
; idea is that 1K = 1 paritition to avoid
; gobbling all of our small partitions.
; we deal with 256 byte memory units so we
; won't overflow a word.
; AX = # partitions
; DX = memory size
push ax ! dec ax
mov cl,2
shl ax,cl
mov cx,es:mpb_max[si]
add cx,(2*satlen)
; If MAX memory is FFFF, SAT adjustment
; wraps around so force FFFF.
cmp cx,(2*satlen) ! jae mlav_added
mov cx,0ffffH
mlav_added:
cmp cx,dx ! jbe mlav_ab
xchg dx,cx
mlav_ab: sub dx,cx ! mov cl,4 ! shr dx,cl
add dx,ax ! mov cx,dx
pop ax ! pop es ! ret
mla_makemau:
;-----------
; input: BX = address of ML element Root
; AX = number of elements
; output: BX = MAU address
cmp ax,1 ! jg mlam_getmd
mov si,m_link[bx] ! mov cx,m_link[si]
mov m_link[bx],cx ! mov bx,si
sub cx,cx ! mov m_plist[bx],cx
mov m_link[bx],cx
jmp mla_initmau
mlam_getmd:
push ax ! push bx
call getmd
mov di,bx ! pop bx ! pop ax
jcxz mlam_gotmd
sub bx,bx ! ret
mlam_gotmd:
mov m_link[di],0 ! mov m_length[di],0
mov si,m_link[bx] ! mov m_plist[di],si
mov cx,m_start[si] ! mov m_start[di],cx
mlam_next:
mov cx,m_length[si] ! add m_length[di],cx
dec ax ! cmp ax,0 ! je mlam_nomore
mov si,m_link[si] ! jmps mlam_next
mlam_nomore:
push bx
mov bx,m_link[si]
mov m_link[si],0
pop si ! mov m_link[si],bx
mov bx,di ! sub cx,cx ! ;jmp mla_initmau
mla_initmau:
;----------
; input: BX = address of MAU
; output: BX = address of MAU
; CX = 0
mov dx,m_start[bx] ! mov cx,m_length[bx]
push cx ! push es ! mov es,dx ! sub ax,ax
mov di,ax ! mov cx,((32*satlen)/2)
rep stos ax ! pop es
pop cx ! mov ds,dx
mov byte ptr .0,31
sub cx,(2*satlen) ! add dx,(2*satlen)
mov si,satlen ! mov sat_start[si],dx
mov sat_length[si],cx ! mov sat_nall[si],0
mov ds,sysdat
sub cx,cx ! ret
;============
mlfree_entry: ; Free from Mem List
;============
; input: DX = MAU address
; BX = ML Root
mov si,dx
cmp m_plist[si],0 ! je mlf_freeone
mov di,si
mov si,m_plist[si]
mlf_nmd: cmp si,0 ! je mlf_endfree
push m_link[si] ! push bx ! push di
call ml_insert
pop di ! pop bx ! pop si ! jmps mlf_nmd
mlf_endfree:
mov bx,di ! call freemd
jmps mlf_exit
mlf_freeone:
call ml_insert
mlf_exit:
sub bx,bx ! mov cx,bx ! ret
ml_insert:
;---------
; input: SI = address of MD to insert
; BX = ML Root
mov di,m_link[bx]
cmp di,0 ! je mli_ins
mov ax,m_start[di]
cmp ax,m_start[si] ! ja mli_ins
mov bx,di ! jmps ml_insert
mli_ins:mov ax,m_link[bx] ! mov m_link[bx],si
mov m_link[si],ax
ret


155
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/PARSE.SUP Normal file
View File

@@ -0,0 +1,155 @@
;*****************************************************
;*
;* Parse Filename Function
;*
;*****************************************************
;========= =========================
parse_ent: ; Parse filename into FCB
;========= =========================
; input: DX -> PCB in u_wrkseg
; output: BX = 0ffffh on error
; = 0 on last name in string
; = offset of delimiter following name
; CX = Error Code
;
; PCB: +----+----+----+----+
; | NAMEADR | FCBADR |
; +----+----+----+----+
;
; NAMEADR = offset of String to parse
; FCBADR = offset of FCB in u_wrkseg
;
; Parsed FCB:
; 0 => drive, 0=default, 1=A, 2=B, ...
; 1- 8 => name, converted to upper case,
; padded w/blanks
; 9-11 => type, converted to upper case,
; padded w/blanks
; 12-15 => set to zero
; 16-23 => password, convered to upper case,
; padded w/blanks
; 24-25 => address of password field in 'filename',
; set to zero if password length=0
; 26 => length of password (0-8)
; 27-31 => left as is
mov ax,u_wrkseg
push ds ! mov ds,ax ;DS->u_wrkseg
push es ! mov es,ax ;ES->u_wrkseg for string ops
mov bx,dx ! mov si,pcb_flnmptr[bx] ;SI->nxt char in parse string
mov bx,pcb_fcbptr[bx] ;BX -> FCB
call fcbi ! call debl ;init FCB, deblank parse str
mov bp,e_badfname ;BAD FILENAME
;BP=error code if error
call delim ! jnz prs1 ;chk 1st char
jmp pfn_endp
prs1: mov ch,al ! inc si ! mov al,[si] ;see if Disk spec
cmp al,':' ! jne prs2
mov bp,e_illdisk ;drive specified
mov al,ch ! sub al,'A' ! jc pfn_err ;see if legal
cmp al,16 ! jge pfn_err
inc al ! mov fcb_dr[bx],al ;good drv, set fcb_dr field
mov bp,e_badfname
inc si ! call delim ! jnz prs3 ;check nxt char
cmp al,'.' ! je pfn_err ;hit delim
cmp al,':' ! je pfn_err ; see if legal
cmp al,';' ! je pfn_err
jmp prs3
prs2: dec si ;use default disk
prs3: ;parse filename
mov di,bx ! lea bx,fcb_name[di]
mov ch,8 ! call setfld ;fill in FCB
cmp ch,0 ! jne prs4
call delim ! jz prs4 ;see if more than 8 chars
pfn_err: mov cx,bp
mov bx,0ffffh ! pop es ! pop ds ! ret
prs4: cmp al,'.' ! jnz prs5 ;see if filetype
mov bp,e_badftype
mov ch,3 ! lea bx,fcb_type[di]
inc si ! call setfld ;fill in FCB
cmp ch,0 ! jne prs5
call delim ! jz prs5
jmp pfn_err
;parse passwd
prs5:
cmp al,';' ! jnz prs8 ;see if password delim
mov bp,e_ill_passwd
mov ch,8 ! lea bx,fcb_pwd[di]
inc si
mov fcb_pptr[di],si ;pointer to password if any
call setfld ;yes
mov cl,8 ! sub cl,ch
mov fcb_plen[di],cl
cmp cl,0 ! jne prs51
mov fcb_pptr[di],0 ;no password
prs51: cmp ch,0 ! jne prs8
call delim ! jz prs8
jmp pfn_err
prs8: mov bx,si ! call debl ;see if more to parse
call delim ! jnz pfn_out ;if yes,exit
mov bx,si
cmp al,0 ! je pfn_endp
cmp al,cr ! jne pfn_out
pfn_endp: mov bx,0 ;NOPE
pfn_out:sub cx,cx ! pop es ! pop ds ! ret ;exit
setfld: ; fill in a field until end of field or delim
;------
pop dx ! call delim ! push dx
jz setret
cmp al,'*' ! jnz setfld1
mov byte ptr [bx],'?'
inc bx ! dec ch ! jnz setfld
jmp setfld2
setfld1: mov [bx],al ! inc bx ! dec ch
setfld2: inc si ! cmp ch,0 ! jne setfld
setret: ret
delim: ; see if char is delim, if not UPPER it, err if illegal
;-----
; input: SI -> next char in parse string
; output: 'z' flag on if delimiter found
; character converted to UPPER if 'a'-'z'
; AL = converted char
mov cl,ndelims ! mov al,[si] ;See if Delimiter
push di ! mov di,offset delims ;look at delim string
delnxt: cmp cl,0 ! je no_del ;if end of delims,not delim
cmp cs:[di],al ! je delret ;if delim, ret w/ z set
dec cl ! inc di ! jmps delnxt ;try next delim
no_del: cmp al,' ' ! ja del_up ;not delim, check graphic
pop di ! pop bx ! mov cx,e_badfname ;not graphic, err
jmp pfn_err ;go directly out, bypass ret
del_up: cmp al,'a' ! jb delret ;if below 'a', no high bit,ret
cmp al,'z' ! ja del_noup ;if above 'z',
and al,05fh ;make 'a'-'z' UPPER CASE
del_noup: and al,07fh ;strip high bit
delret: pop di ! ret
delims db 0,tab,cr,'.:;=,/[]<> '
ndelims equ (offset $)-(offset delims)
debl: ;strip leading blanks
;-------
; input: SI -> parse string
; output: SI -> first non-blank or tab char
cmp byte ptr [si],' ' ! je blnk
cmp byte ptr [si],tab ! je blnk
ret
blnk: inc si ! jmps debl
fcbi: ; Initialize FCB
;-------
mov di,bx ! sub ax,ax
sub cx,cx ! stosb ; 0 =0
mov al,' ' ! mov cl,11 ! rep stosb ; 1-11=' '
mov al,0 ! mov cl,2 ! rep stosw ;12-15=0
mov al,' ' ! mov cl,8 ! rep stosb ;16-23=' '
mov al,0 ! mov cl,3 ! rep stosb ;24-26=0
ret


41
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/PATCH.COD Normal file
View File

@@ -0,0 +1,41 @@
;*****************************************************
;*
;* PATCH AREA -- 128 bytes long
;*
;*****************************************************
patch:
nop ! nop ! nop ! nop ! nop ! nop ;00-0f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;10-1f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;20-2f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;30-3f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;40-4f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;50-5f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;60-6f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop
nop ! nop ! nop ! nop ! nop ! nop ;70-7f
nop ! nop ! nop ! nop ! nop ! nop
nop ! nop ! nop ! nop


250
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/PROC.RTM Normal file
View File

@@ -0,0 +1,250 @@
;*****************************************************
;*
;* Process Routines
;*
;*****************************************************
;====== =========================
freepd: ; Free Process Descriptor
;====== =========================
; entry: SI = PD address
; Assumes no memory and on no list except thread.
; Called only from TERM_ACT in the dispatcher
mov di,(offset thrdrt)-p_thread
freepd_npd:
mov bx,p_thread[di] ;find pd on thread
cmp bx,si ! je freepd_trd
mov di,bx ! jmps freepd_npd
freepd_trd:
mov ax,p_thread[si] ! mov p_thread[di],ax
mov ax,p_flag[si] ! and ax,pf_table
cmp ax,0 ! jz freepd_exit
mov bx,pul ! mov p_link[si],bx
mov pul,si
freepd_exit:
ret
;========== ================
proc_creat: ; Create Process
;========== ================
; DX = pd address in u_wrkseg
cmp dx,0 ! jne cp_doit
sub bx,bx ! ret
cp_doit:
call getpdadr ;si->pdaddr in rtm
jcxz cp_gpd
mov bx,0ffffh ! ret
cp_gpd:
mov dx,p_link[si]
push dx ! push si
; init uda fields
cp_uda:
;set Parent
mov bx,rlr
mov p_parent[si],bx
mov p_conmode[si],0 ;console mode - not inherited
;unless RSX which aren't yet
;implemented
mov p_tkcnt[si],0 ;temp keep count
and p_flag[bx],not (pf_childabort + pf_resource)
mov al,p_lst[si]
;cmp al,nlstdev ! jb cp_slst ;removed for network, 1/5/84 FMB
; mov al,0 ;make sure its a legal list device
cp_slst:
;if mpm
; add al,ncondev
;endif
mov p_lst[si],al ;list device is relative to 0 in
;CCP/M
;set up p_userdisp for callf in dispatcher
mov word ptr p_userdisp[si],offset def_emultr
mov word ptr p_userdisp+2[si],cs
;share memory
cmp p_mem[bx],0 ! je cp_nm
cmp p_mem[si],0 ! jne cp_nm
lea di,p_mem[bx]
cp_mnxt: mov di,ms_link[di]
cmp di,0 ! je cp_nm
push di
push ms_start[di] ! push si ! push bx
mov cx,f_share ! mov dx,sp
push ds ! mov ax,ss ! mov ds,ax
call osif ! pop ds
pop bx ! pop si ! pop ax ! pop di
jmps cp_mnxt
cp_nm:
;set physical UDA segment
mov ax,u_wrkseg
mov dx,p_uda[si] ! add dx,ax
mov p_uda[si],dx
;inherit password
push es ! push ds
mov cx,es ! mov es,dx ! mov ds,cx
mov si,offset u_df_password ! mov di,si
mov cx,4 ! rep movsw
;set initial segment values
mov ds,dx ! xor dx,dx
cmp ds:u_initcs,dx ! jne cp_uda1
mov ds:u_initcs,ax
cp_uda1:cmp ds:u_initds,dx ! jne cp_uda2 ;DX=0
mov ds:u_initds,ax
cp_uda2:cmp ds:u_initss,dx ! jne cp_uda3 ;DX=0
mov ds:u_initss,ax
cp_uda3:cmp ds:u_inites,dx ! jne cp_uda4 ;DX=0
mov ds:u_inites,ax
cp_uda4:
;Interrupt vector save areas:
;Get parent's interrupt vectors 0,1,3,4,224,225
;into child's UDA, if the
;interrupt vector is not initialized in the
;child's UDA.
mov ds,dx ;DX,DS=0,ES=child's UDA
mov si,dx ;divide error vector, #0
mov di,offset u_ivectors
call cp_icopy
call cp_icopy ;single step, #1
add si,4 ! add di,4 ;skip NMI, #2
call cp_icopy ;1-byte, #3
call cp_icopy ;overflow, #4
mov si,offset i_os_ip
mov di,offset u_os_ip
call cp_icopy ;O.S. entry, #224
call cp_icopy ;debugger entry, #225
; set user's stack
push es ! pop ds
mov ax,ds:u_initss
mov ds:u_ss,ax
mov ax,ds:u_stack_sp
mov ds:u_sp,ax
; set other uda values
xor dx,dx
mov ds:u_delim,'$' ;console mode init
mov ds:u_error_mode,dl
mov ds:u_pd_cnt,dl
mov ds:u_mult_cnt,1
mov ds:u_in_int,true
;mov ds:u_insys,dl ;don't set insys
mov bx,ds:u_initds
mov ds:u_ds_sav,bx
mov ds:u_dma_seg,bx
mov ax,ds:u_inites
mov ds:u_es_sav,ax
mov ds:u_dparam,dx
mov ds:u_flag_sav,dx
mov ds:u_conccb,dx
mov ds:u_lstccb,dx
; setup user stack for iret
mov ds,ds:u_ss
mov di,u_sp ;sp->offset
mov ax,u_initcs
mov 2[di],ax ; ->segment
mov word ptr 4[di],0200h ; ->flags, interrupts on
pop ds ! pop es ; DS=SYSDAT, ES=UDA
; put on thread list
pop si ! pushf ! cli ; don't need SYNC here
mov dx,thrdrt ; but this code cannot
mov p_thread[si],dx ; be reentrant
mov thrdrt,si
; put on dispatcher ready list
mov dx,drl ! mov p_link[si],dx
mov drl,si ! popf
; do the next process
pop dx ! jmp proc_creat
cp_icopy:
;--------
; Entry: ES:DI = UDA ivector location to store
; DS:SI = ivector to copy
; DX = 0
; Exit:
; DI,SI = incremented by 4
cmp es:word ptr 0[di],dx ;DX=0, DI=UDA ivector to copy
jne cp_nocopy ;don't copy interrupt vector
cmp es:word ptr 2[di],dx ;if it is <> 0 in the UDA
jne cp_nocopy
mov cx,2 ;move two words
rep movsw ;copy to UDA
ret
cp_nocopy:
add si,4 ! add di,4
ret
getpdadr:
;--------
; entry: DX = PD address in U_WRKSEG
; exit: CX = 0 successful
; SI = PD address in SYSDAT if success
; CX =
; Make sure PD address is in SYSDAT. If not, copy into
; one in PD table. Make address relative to SYSDAT
push dx ;save PD in U_WRKSEG
mov bx,pdlen
call sysdat_chk
jcxz gpd_bad
mov ax,u_wrkseg ;PD is within SYSDAT
mov bx,ds
sub ax,bx ;U_WRKSEG-SYSDAT
mov cl,4 ! shl ax,cl ;make into bytes
pop si ;SI relative to U_WRKSEG
add si,ax ;SI->PD relative to SYSDAT
jmps gpd_done
gpd_bad:
pop si ;U_WRKSEG:SI->PD to copy
pushf ! cli ;turn off interrupts while
mov di,pul ;changing the PUL
test di,di
jnz gpd_have
mov cx,e_no_pd ;no free PDs left
popf ! ret
gpd_have: ;DI->PD in SYSDAT
mov ax,p_link[di]
mov pul,ax ;update PUL
popf ;allow interrupts
push di ;save address of PD in SYSDAT
push es ;save UDA
push ds ;SYSDAT
mov ds,u_wrkseg ;DS=U_WRKSEG
pop es ;ES=SYSDAT
mov cx,pdlen/2
rep movsw ;copy PD into SYSDAT PD
push es ! pop ds ;DS=SYSDAT
pop es ;ES=UDA
pop si ;SI=PD in SYSDAT
or p_flag[si],pf_table ;got it from PD table
gpd_done:
xor cx,cx
ret


456
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/QUE1.RTM Normal file
View File

@@ -0,0 +1,456 @@
;*****************************************************
;*
;* Queue Routines
;*
;*****************************************************
; Each queue system entry point is mutually exclusive
; of the other queue system entry points.
; All the routines called in QUE2.RTM are
; subroutines of the entry points in QUE1.RTM and
; thus are called only when the process has ownership
; of the q system.
; If a process is already in the queue system another process
; will wait until the first process calls Q_UNSYNC.
; This allows us to keep interrupts on while using shared variables.
; To protect against terminating and potentially losing a QD,
; a message or neglecting to wake up a DQing or NQing
; process; a "no abort region" is entered whenever
; we obtain the queue system. In addition if we assign
; the queue system to a DQing or NQing process, the new owner
; of the q system is forced into a "no abort region". This
; makes the environment of the waking NQing or DQing process appear
; as if it never went to sleep.
; A note for the uninitiated: DQing is short for "Decoding from a Queue"
; or reading from a queue. NQing is short for "eNcoding to a Queue"
; or writing to a queue.
;=========== =======================
makeq_entry: ; Create a System Queue
;=========== =======================
; input : U_WRKSEG:DX = address of QD to create
; output: BX = 0 if okay , 0ffffh if error
; CX = error Code
call q_sync ;obtain q system, BX,DX preserved
call getqdaddr ;get QD and q buffer
jcxz qm_gotqd
jmp qm_err
qm_gotqd: ;DI->QD in SYSDAT
;make sure this queue doesn't
;already exist
qm_chk:
push es ;save UDA
mov es,sysdat
mov si,(offset qlr)-q_link
qm_nxt:
mov si,q_link[si] ;go down QLR to see if QD already
test si,si ! jz qm_go ;exists
push di ! push si ;save new QD and QLR ptr
mov cx,qnamsiz/2
add di,q_name ;ES:DI->QPB.NAME
add si,q_name ;DS:SI->QPB.NAME
repe cmpsw
pop si ! pop di ;restore QLR ptr and new QD
jne qm_nxt ;no match try next QD
pop es ;names match, restore UDA
call remqd ;QD pointed to by DS:DI
mov cx,e_q_inuse
jmps qm_err
qm_go: ;no match - alright to make this q
pop es ;ES=UDA
xor dx,dx ;initialize the QD
mov q_dq[di],dx
mov q_nq[di],dx
mov q_msgcnt[di],dx
mov q_msgout[di],dx
mov ax,qlr ;put QD on QLR
mov q_link[di],ax
mov qlr,di
xor bx,bx ;return success
jmps qm_ret
qm_err:
mov bx,0ffffh
qm_ret:
jmp q_unsync ;release q system; BX,CX preserved
;=========== ======================
openq_entry: ; Find an active Queue
;=========== ======================
; input: U_WRKSEG:DX = address of QPB
;
; output: sets QPB.QADDR to QD offset in SYSDAT
; BX = 0 if okay, 0ffffh if not
; CX = error Code
call q_sync ;obtain q system; BX,DX preserved
push es ;save UDA
mov es,u_wrkseg
mov si,(offset qlr)-q_link
mov di,dx ;ES:DI->QPB
qo_nqd:
mov si,q_link[si] ;go down QLR until QD name
test si,si ! jnz qo_cmp ;matches QPB name or end of QLR
pop es ;ES=UDA
mov cx,e_no_queue ;found end of QLR - can't open
jmps qo_err
qo_cmp:
push di ! push si ;compare names
mov cx,qnamsiz/2
add si,q_name ;DS:SI->QD.NAME
add di,qpb_name ;ES:DI->QPB.NAME
repe cmpsw
pop si ! pop di ;restore QD,QPB
jne qo_nqd ;try next QD if no match
test q_flags[si],qf_hide ;names match
jz noprot ;check for protection:
mov bx,rlr ;must be system process to
test p_flag[bx],pf_sys ;open q with QF_HIDE set
jnz noprot
pop es ;ES=UDA
mov cx,e_q_protected ;QF_HIDE and not SYS PD
jmps qo_err
noprot:
mov es:qpb_qaddr[di],si ;write the QD offset into
pop es ;ES=UDA
xor bx,bx ;the QPB_QADDR field
jmps qo_ret ;to open the q
qo_err: ;CX=error code
mov bx,0ffffh
qo_ret:
call q_unsync ;release q system; BX,CX preserved
ret
;============= =======================
deleteq_entry: ; Delete a System Queue
;============= =======================
; Takes QD off the QLR and place it in the QUL
; input: U_WRKSEG:DX = offset of QPB
; output: BX = 0 if ok, 0ffffh if error
; CX = error code
mov ax,es ;save UDA
mov es,u_wrkseg ;get QD address from user's
mov di,dx ;QPB
mov di,es:qpb_qaddr[di] ;DS:DI->QD (unverified)
mov es,ax ;ES=UDA
;Check for KEEP, SYS Flags
;DS:DI->QD
test q_flags[di],qf_keep
jnz qd_err1
test q_flags[di],qf_hide
jz qd_ok1
mov bx,rlr ;if hide flag then
test p_flag[bx],pf_sys ;SYS flag must be on in PD
jnz qd_ok1
qd_err1: mov cx,e_q_protected
mov bx,0ffffh
ret
qd_ok1:
push di ;DI->QD
call q_sync ;obtain q system; BX,DX preserved
pop di
mov ax,q_dq[di] ;if any process is NQing or
mov dx,q_nq[di] ;DQing we can't delete
or dx,ax ! mov cx,e_q_inuse
jnz qd_err2
mov bx,(offset qlr)-q_link
qd_nqd: ;look for QD on QLR
mov si,q_link[bx] ;DI=QD to delete
test si,si ! jz qd_noq
cmp si,di ! je qd_found
mov bx,si ! jmps qd_nqd ;try next queue
qd_found:
mov ax,q_link[di] ;found the queue, remove
mov q_link[bx],ax ;it from QLR
call remqd
xor bx,bx ;return success
jmps qd_ret
qd_noq:
mov cx,e_no_queue
qd_err2:
mov bx,0ffffh
qd_ret:
jmp q_unsync ;release q system
;ret ;BX,CX preserved
;=========== ============
readq_entry: ; Read Queue
;=========== ============
xor al,al ! jmps readq
;============
creadq_entry: ; Conditional Read Queue
;============
mov al,0ffh
; jmps readq
readq: ; Read message from queue
;----- -------------------------
; If no buffer is available the process
; making an unconditional READQ is placed into the DQ list.
;
; input: U_WRKSEG:DX = QPB
; AL = 0 if unconditional
; <> 0 if not
; output: BX = 0 if okay
; 0ffffh if error
; CX = Error Code
push ax ;save cond code
call q_sync ;get q system; BX,DX preserved
call queverify ;is the QPB valid ?
pop ax ;AL=cond code
mov si,dx ;U_WRKSEG:SI->QPB
jcxz qr_ver ;CX=0 QPB is ok
jmp qr_err ;CX=error code from
qr_ver: ;queverify
push es ;save UDA
mov es,u_wrkseg ;ES:SI->QPB
mov bx,es:qpb_qaddr[si] ;BX->QD
cmp q_msgcnt[bx],0 ;is there a msg to read ?
jne qr_readit
qr_wait:
pop es ;ES=UDA
test al,al ! jz qr_wait1 ;conditional read if AL <> 0
mov cx,e_q_empty
jmps qr_err
qr_wait1: ;ES=UDA
push bx ! push si ;QD, QPB
lea dx,q_dq[bx] ;DX=addr of DQ List
mov bl,ps_dq ;sleep status=DQ
call q_wait ;wait for a DQ
;we now own the q system
;and cannot be aborted
pop si ! pop bx ;QPB, QD
push es ;save UDA
mov es,u_wrkseg
qr_readit:
mov di,es:qpb_buffptr[si] ;ES:[DI]->user's queue buffer
mov cx,q_msglen[bx] ;ES=U_WRKSEG
test cx,cx ! jnz qr_lmsg ;check message length
xor ax,ax
test q_flags[bx],qf_mx ;msglen=0, check for MX q
jz qr_end
mov ax,rlr ;its a MX queue
mov q_buf[bx],ax ;BUF = PD addr of owner
xor ax,ax
jmps qr_end
qr_lmsg: ;msglen > 0
mov ax,q_msgout[bx] ! push ax ;MSGOUT is # of message to read
mul cx ! add ax,q_buf[bx] ;compute its start in buffer
mov si,ax
rep movsb ;move to QPB buffer
pop ax ! inc ax ;set MSGOUT to next message
cmp ax,q_nmsgs[bx] ;circular buffers, so
jne qr_end ;check for wrap around
xor ax,ax
qr_end:
pop es ;ES=UDA
mov q_msgout[bx],ax
dec q_msgcnt[bx]
lea dx,q_nq[bx]
call q_assign_sync ;give the queue system to
;first NQing process if any,
call q_unsync ;release q system if we still
;own it, exit no abort region
xor bx,bx ;indicate success
ret
qr_err:
call q_unsync ;release q system, exit no abort
;region, BX,CX preserved
mov bx,0ffffh ;indicate error
ret
;============ =============
writeq_entry: ; Write Queue
;============ =============
xor al,al ! jmps writeq
;============= =========================
cwriteq_entry: ; conditional Write Queue
;============= =========================
mov al,0ffh
;jmps writeq
writeq: ; Write message to queue
;------ ------------------------
; If no buffer is available when making an unconditional
; WRITEQ call, the calling process is placed into the NQ list.
;
; input: U_WRKSEG:DX = QPB
; AL = 0 if unconditional
; <> 0 if not
; output: BX = 0 if okay
; 0ffffh if error
; CX = Error Code
push ax ;save cond code
call q_sync ;get queue system
;BX,DX preserved
call queverify ;is the QPB valid ?
pop ax ;AL = cond code
mov di,dx ;U_WRKSEG:DI->QPB
jcxz qw_ver ;CX=0 QPB is ok
jmp qw_err ;CX=error code from
qw_ver: ;queverify
push es ;save UDA
mov es,u_wrkseg ;ES:DI->QPB
mov bx,es:qpb_qaddr[di] ;BX->QD
mov cx,q_msgcnt[bx]
cmp cx,q_nmsgs[bx] ;is there a buffer to write ?
jne qw_writeit
qw_wait:
pop es ;ES=UDA
test al,al ! jz qw_wait1 ;conditional read if AL <> 0
mov cx,e_q_full
jmps qw_err
qw_wait1: ;ES=UDA
push bx ! push di ;save QD, QPB
lea dx,q_nq[bx] ;DX=addr of NQ List
mov bl,ps_nq ;sleep status=NQ
call q_wait ;sleep on NQ List
;q system is assigned to us,
;we are in no abort region
;by DQing process that woke us
pop di ! pop bx ;QPB,QD
push es ;save UDA
mov es,u_wrkseg
qw_writeit:
mov si,es:qpb_buffptr[di] ;U_WRKSEG:[SI]->user's queue buffer
mov cx,q_msglen[bx] ;ES=U_WRKSEG
test cx,cx ! jnz qw_lmsg ;check message length
test q_flags[bx],qf_mx ;msglen=0, check for MX q
jz qw_end
xor ax,ax
mov q_buf[bx],ax ;its a MX queue
jmps qw_end ;BUF = 0
qw_lmsg: ;msglen > 0
mov ax,q_msgout[bx]
add ax,q_msgcnt[bx] ;AX = # of message to write
cmp ax,q_nmsgs[bx] ;check for wrap around
jb qw_move
sub ax,q_nmsgs[bx]
qw_move:
mul cx ! add ax,q_buf[bx] ;compute its start in buffer
mov di,ax ;DI offset of new msg in buffer
mov ax,ds ! mov dx,es
mov es,ax ! mov ds,dx ;ES=SYSDAT, DS=U_WRKSEG
rep movsb ;move to QPB buffer
mov ax,es ! mov ds,ax ;DS=SYSDAT
qw_end:
pop es ;ES=UDA
inc q_msgcnt[bx] ;one more message in the queue
lea dx,q_dq[bx] ;wake DQing process if any
call q_assign_sync
call q_unsync ;release q system if we still
xor bx,bx ;own it, exit no abort region
ret ;BX=0: success
qw_err:
call q_unsync ;release q system; exit no abort
;region BX,CX preserved
mov bx,0ffffh ;indicate error
ret
q_wait: ;wait on DQ or NQ list
;------
; entry: DX = list to wait on
; BL = sleep status
; calling process owns queue system through
; a call to q_sync
; Queue message or buffer space is not available.
; Give up queue system and sleep on DQ or NQ list, but
; do not allow any other process to read or write to a queue
; until we get on the sleep list.
pushf ! cli ;keep abort spec from running ...
push bx ! push dx ;save sleep status, list address
call q_unsync ;does not go to dispatcher, we can be
pop dx ! pop bx ;aborted once on sleep list
call sleep_entry ;go to dispatcher
popf ;come back after q_assign call
ret ;Q_ASSIGN: wakes us up when resource
;is ready
q_sync: ;obtain ownership of q system
;------
; entry: interrupts should be on
; ES=UDA
; exit: we own the queue system for make,open,read,write,delete
; queue operations, interrupts unchanged
; BX,DX preserved - usually entry parameters
push bx ! push dx
call no_abort_entry ;we cannot abort while in the queue system
mov bx,offset q_spb
call sync_entry
pop dx ! pop bx
ret
q_unsync: ;release the queue system
;-------- ;to other processes
; entry: interrupts can be or off
; exit: interrupts unchanged,
; have not gone to dispatcher,
; BX,CX preserved - usually return codes
push bx ! push cx
mov bx,offset q_spb
call unsync_entry ;wait for queue system
call ok_abort_entry ;allow calling PD to be terminated
pop cx ! pop bx
ret
q_assign_sync:
;-------------
; entry: DX = address of DQ or NQ list to give the queue
; exit: none
; Assign is used so a process is forced to read or write
; after DQing or NQing. Otherwise an awakening DQing or NQing
; process could be deleted, leaving a message or buffer space
; available with other processes still DQing or NQing.
; This message or buffer space would never be reclaimed.
; To prevent this situation, the waking DQing or NQing process
; is kept from aborting and assigned the QSPB. Note
; it is ok for a process to be aborted while it is on the NQ or
; DQ list before this routine is called.
pushf ! cli ;keep abort spec from terminating
mov bx,dx ;waking process
mov dx,[bx] ;first process on list
test dx,dx ;is there a process to wake?
jz qa_ret
push bx ;save list root
call no_abort_spec_entry ;can not abort while in queue
pop dx ;system
popf ;interrupts are ok now -
mov bx,offset q_spb ;present owner and next owner
jmp assign_sync_entry ;have TEMPKEEP on
qa_ret:
popf
ret


225
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/QUE2.RTM Normal file
View File

@@ -0,0 +1,225 @@
;****************************************************************
;* *
;* Queue system subroutines: Q System must be owned *
;* before calling any of the following routines *
;* *
;****************************************************************
queverify: ; check QLR for existence of QD address
;--------- ---------------------------------------
; entry: U_WRKSEG:DX = offset of QPB
; exit: CX = 0 if queue is found
; CX = E_NO_QUEUE error code, if not
; BX=SI=QD offset
; ES,DX preserved
push es ;save UDA
mov es,u_wrkseg
mov bx,dx ;ES:BX->QPB
mov bx,es:qpb_qaddr[bx] ;get QD from user's QPB
pop es ;restore UDA
lea si,qlr-q_link
qv_nxt:
mov si,q_link[si] ;SI addresses of valid QDs
test si,si ! jz qv_nqf
cmp bx,si ! jne qv_nxt
xor cx,cx ! ret ;BX=SI=QD offset, return success
qv_nqf:
mov cx,e_no_queue ;couldn't find the queue
ret
getqdaddr:
;----------
; entry: DX = offset of QD in U_WRKSEG
; exit: DI = offset of QD in SYSDAT
;
; If QD address is within SYSDAT use it.
; Else get a QD from QDUL and set QF_TABLE flag.
; If Q_NMSGS=0 in QD then return error.
; If 0 length buffer needed, zero the Q_BUF field.
; If buffer space is within SYSDAT use it. Else get buffer
; from QMAU. Return the QD address within SYSDAT.
push dx ;save QD offset
mov bx,qdlen
call sysdat_chk
jcxz g_qul ;CX=0 if not within SYSDAT
mov ax,u_wrkseg ;# of paragraphs to U_WRKSEG
mov bx,ds
sub ax,bx ;from SYSDAT
mov cl,4 ! shl ax,cl ;make into # of bytes
pop di ;DI=QD in U_WRKSEG
add di,ax ;make QD relative to SYSDAT
jmps g_qd
g_qul:
mov di,qul ;get QD from QUL
test di,di ;DI=unused QD
jnz g_gotqd
pop dx
mov cx,e_no_qd ;no QD available
ret
g_gotqd:
mov ax,q_link[di]
mov qul,ax
pop si ;SI=QD in U_WRKSEG
push di ;save SYSDAT QD
mov cx,qdlen/2
; ES=UDA, DS=SYSDAT
mov ax,ds
mov ds,u_wrkseg ; DS:SI = QD in U_WRKSEG
push es ! mov es,ax ; ES:DI = QD in SYSDAT
rep movsw ; copy QD into QD in SYSDAT
mov ax,es ! mov ds,ax
pop es ; ES=UDA, DS=SYSDAT
pop di ; SYSDAT:DI -> New QD
or q_flags[di],qf_table ; Set "from table" flag
g_qd: ;DI=QD in SYSDAT
xor cx,cx ;CX=0
cmp q_nmsgs[di],cx ;must have one or more msgs
jne g_buflen ;or illegal queue
mov cx,e_no_qbuf
jmps g_qdfree
g_buflen: ;if MX or buffer length is zero
test q_flags[di],qf_mx ;0 Q_BUF field and return
jnz g_mx ;CX=0 to indicate success
cmp q_msglen[di],cx
jne g_getbuf
g_mx:
mov q_buf[di],cx
ret
g_getbuf: ;non 0 length buffer needed
cmp q_buf[di],0 ;is there a buffer specified?
je g_buf
mov ax,q_msglen[di] ;yes make sure it fits in SYSDAT
mul q_nmsgs[di] ;AX=needed buffer space
mov bx,ax
mov dx,q_buf[di]
call sysdat_chk
jcxz g_buf ;CX=0 not within SYSDAT
mov ax,u_wrkseg ;# of paragraphs to U_WRKSEG
mov bx,ds
sub ax,bx ;from SYSDAT
mov cl,4 ! shl ax,cl ;make into # of bytes
add q_buf[di],ax ;make buffer relative to SYSDAT
xor cx,cx ;indicate success
ret
g_buf: ;allocate buffer space to queue
call qspace
jcxz g_ret
mov cx,e_no_qbuf ;no buffer space
g_qdfree:
mov ax,qul ;error return QD to QUL
mov q_link[di],ax
mov qul,di ;CX = error code
g_ret:
ret
sysdat_chk:
;----------
; entry: DX = offset of data structure to check
; relative to U_WRKSEG
; BX = length of data structure
; exit: CX <> 0 if within SYSDAT
; or wrap around
; CX = 0 if not within SYSDAT
; SI,DI preserved
; Check data structure for being within SYSDAT
; Also check that data structure doesn't wrap
; around at 64K, or 1 megabyte.
add dx,bx ;find end of data structure
jc sc_no ;check for 64K wrap around
add dx,0fh
mov cl,4 ;round up to next paragraph
shr dx,cl ;1st paragraph after struct relative
add dx,u_wrkseg ;to U_WRKSEG
jc sc_no ;next paragraph after struct
;check for 1 MB wrap around
mov ax,sysdat
cmp dx,ax ;check for below SYSDAT
jb sc_no
add ax,1000h ;check for above SYSDAT
cmp ax,endseg ;must be within 64k and ENDSEG
jb sc_end ;(use the smaller of the 2)
mov ax,endseg
sc_end:
cmp dx,ax ;DX=next paragraph,
ja sc_no
mov cl,1 ;indicate within SYSDAT
ret
sc_no:
xor cx,cx
ret
qspace:
;------
; entry: DI = QD address
; exit: CX = 0 if ok else error code
; DI preserved
; Allocate buffer space for QD
; The QMAU describes the Memory Allocation Unit
; for the queues. QMAU is set up by GENCCPM or GENSYS.
mov ax,q_msglen[di] ;compute size of buffer
mul q_nmsgs[di] ;AX=size of request
xor cx,cx
push cx ! push cx ! push ax ;call MALLOC
push ax ! push cx ;with MPB on stack
mov dx,sp ! mov ax,ss
mov ds,ax
mov bx,offset qmau
push di ;save QD
mov cx,f_maualloc ;go through OSIF to
call osif ;get U_WRKSEG=SS
pop di ;DI=QD
mov ds,sysdat
cmp cx,0 ! jne qspace_ret
mov bp,sp
mov ax,mpb_start[bp]
mov q_buf[di],ax ;address of buffer
qspace_ret:
add sp,10 ;pop MPB from stack
ret
remqd:
;-----
; Place QD on queue unused list
; entry: DS:DI = QD address
; exit: none
mov ax,q_flags[di]
and ax,qf_table ! jz rqd_exit
mov ax,qul ! mov q_link[di],ax
mov qul,di
jmps qrelease
rqd_exit:
ret
qrelease:
;--------
; entry: DI = QD address
; exit : none
;
; Release buffer space for QD.
; If the released space is ajacent to another
; free area, they are joined in the SAT table.
; The QMAU describes the Memory Allocation Unit
; for the queues. QMAU is set up by GENCCPM or GENSYS.
mov ax,q_buf[di]
mov cx,offset qmau
push ax ! push ax ! push cx ;MFPB on stack
mov cx,f_maufree
mov dx,sp ! mov ax,ss ! mov ds,ax
call osif
add sp,6 ;pop MFPB from stack
mov ds,cs:sysdat ;DS=SYSDAT
ret


80
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/RPL.SUP Normal file
View File

@@ -0,0 +1,80 @@
;**********************************************************
;*
;* Call Resident System Procedure
;*
;**********************************************************
cpb_name equ word ptr 0
cpb_param equ word ptr cpb_name + qnamsiz
;=======
rpl_ent: ; Call Resident Procedure Library
;=======
; input: DX = CPB address in u_wrkseg
; output: BX = return from RPL (also u_retseg)
; 1 if error
; CX = error code
;
; The stack is used like this:
;
; stack bottom ------------------------- higher memory
; 26 | starting DS (sysdat)|
; 24 | starting ES (uda) |
; 22 | seg of rpl_ret: |
; 20 | offset of rpl_ret: |
; 18 | seg of the RPL |
; 16 | offset or RPL |<-------
; 14 | Q /\ | |
; 12 | P || | |
; 10 | | || | |
; 8 | B qname | |
; 6 | L buffptr |------>|
; 4 | O nmsgs |
; 2 | C qaddr |
; 0 | K flgs & net |<------SP
; stack top ------------------------- lower memory
push ds ! push es
mov ds,u_wrkseg ; save ds
mov si,dx
push cs ; rpl_ret segment
mov ax,offset rpl_ret ! push ax ; rpl_ret offset
sub ax,ax ! push ax ! push ax ; QPB buffer
mov di,sp ; DI -> buffer
push (cpb_name+6)[si] ; qpb_name
push (cpb_name+4)[si]
push (cpb_name+2)[si]
push cpb_name[si]
mov si,cpb_param[si] ; SI=param
push di ; qpb_buffer address
inc ax ! push ax ; qpb_nmsgs
dec ax ! push ax ! push ax ; qpb_addr,flg,net
mov dx,sp ! mov di,dx
mov ax,ss ! mov ds,ax
mov cx,f_qopen
push si ! push di ! call osif
pop di ! pop si
cmp cx,0 ! jne rpl_err
mov bx,qpb_qaddr[di]
push ds ! mov ds,sysdat
test q_flags[bx],qf_rpl ! pop ds
jz rpl_err
mov cx,f_qread ! mov dx,di
push si ! call osif ! pop si
cmp cx,0 ! jne rpl_err
add sp,16
mov dx,si
mov ds,u_wrkseg
mov es,u_retseg
retf
rpl_ret: mov ax,es
pop es ! pop ds
mov u_retseg,ax
ret
rpl_err:
add sp,24
pop es ! pop ds
mov bx,1 ! mov cx,e_no_queue
ret


40
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/RTM.A86 Normal file
View File

@@ -0,0 +1,40 @@
include cpyright.def
;*****************************************************
;*
;* RTM - MP/M-86 or CCP/M Real Time Monitor
;*
;*****************************************************
eject ! include system.def
eject ! include modfunc.def
eject ! include modtab.def
eject ! include xioscb.def
eject ! include flg.def
eject ! include mem.def
eject ! include mpb.def
eject ! include pd.def
eject ! include err.def
eject ! include qd.def
eject ! include sync.def
eject ! include cmdh.def
eject ! include apb.def
eject ! include vccb.def
eject ! include uda.def
eject ! include s8087.lib
eject ! include rtmif.rtm
eject ! include sysent.rtm
eject ! include proc.rtm
eject ! include dsptch.rtm
eject ! include flag.rtm
eject ! include que1.rtm
eject ! include que2.rtm
eject ! include findpd.rtm
eject ! include abort.rtm
eject ! include patch.cod
eject ! include vec.fmt
eject ! include uda.fmt
eject ! include sysdat.dat
eject ! include data.bdo
eject ! include xiosdat.fmt ;SUP 5 - DH - 14APR82
eject ! end


96
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/RTMIF.RTM Normal file
View File

@@ -0,0 +1,96 @@
;*****************************************************
;*
;* Concurrent CP/M-86 RTM Interface Routines
;*
;*****************************************************
cseg
org 0
jmp init ;RTM initialization
jmp entry ;RTM entry point
sysdat dw 0 ;SYSDAT segment
supervisor equ offset $
rw 2 ;SUP entry point
org 0ch
dev_ver db 6 ;development system data version
;set in sysdat.fmt
db 'COPYRIGHT (C) 1982,1983,1984'
db ' DIGITAL RESEARCH '
db 'XXXX-0000-'
serial db '654321'
;==== ===========================
init: ; RTM module Initialization
;==== ===========================
mov bx,(offset dispatcher) ;init interrupt pdisp
mov word ptr [bx],offset fdisp
mov word ptr 2[bx],cs
mov bx,(offset rtm_pdisp) ;init intermodule pdisp
mov word ptr [bx],offset farpdisp
mov word ptr 2[bx],cs
mov bx,rlr ;init the init process's userdisp vec
mov word ptr p_userdisp[bx],offset def_emultr
mov word ptr p_userdisp + 2[bx],cs
retf
;*****************************************************
;*
;* RTM Function Table
;*
;*****************************************************
org ((offset $)+1) AND 0fffeh ;Word Boundary
function dw sysreset_entry ;0
dw poll_entry ;1
dw flag_wait_entry ;2
dw flag_set_entry ;3
dw makeq_entry ;4
dw openq_entry ;5
dw deleteq_entry ;6
dw readq_entry ;7
dw creadq_entry ;8-conditional readq
dw writeq_entry ;9
dw cwriteq_entry ;10-conditional writeq
dw delay_entry ;11
dw dispatch_entry ;12
dw terminate_entry ;13
dw creat_proc_entry;14
dw set_prior_entry ;15
dw pd_entry ;16-get PD address
dw abort_spec_entry;17-abort process
dw sleep_entry ;18
dw wakeup_entry ;19
dw findpdname_entry;20
dw sync_entry ;21
dw unsync_entry ;22
dw no_abort_entry ;23
dw ok_abort_entry ;24
dw no_abort_spec_entry ;25
; dw flagalloc ;26
;===== =================
entry: ; RTM Entry Point
;===== =================
xor ch,ch ! shl cx,1 ! mov si,cx
call cs:function[si]
rtm_ret:retf
;==== ================
osif: ; O.S. Interface
;==== ================
callf cs:dword ptr .supervisor ! ret
;====== ================
xiosif: ; XIOS Interface
;====== ================
mov si,mod_entry
callf dword ptr xiosmod[si] ! ret


94
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/S8087.LIB Normal file
View File

@@ -0,0 +1,94 @@
pagesize 45
; *****************************
; * Codemacros for 8087 *
; * numeric data processor: *
; ***************************
;
; stack references:
st equ 0 ; stack top (= register 0)
st0 equ 0 ; register 0
st1 equ 1 ; register 1
st2 equ 2 ; register 2
st3 equ 3 ; register 3
st4 equ 4 ; register 4
st5 equ 5 ; register 5
st6 equ 6 ; register 6
st7 equ 7 ; register 7
;
;
codemacro FRSTOR src:M
db 9bh
segfix src
db 0ddh
modrm 4,src
endm
codemacro FSTCW dst:Mw
db 9bh
segfix dst
db 0d9h
modrm 7,dst
endm
codemacro FDISI
db 9bh
dw 0e1dbh
endm
codemacro FSAVE dst:M
segfix dst
db 0ddh
modrm 6,dst
endm
codemacro FNINIT
dw 0e3dbh
endm
codemacro FNDISI
dw 0e1dbh
endm
codemacro FNSTCW dst:Mw
segfix dst
db 0d9h
modrm 7,dst
endm
codemacro FNSTSW dst:Mw
segfix dst
db 0ddh
modrm 7,dst
endm
codemacro FNCLEX
dw 0e2dbh
endm
codemacro FNSAVE dst:M
db 0ddh
modrm 6,dst
endm
codemacro FNSTENV dst:M
segfix dst
db 0d9h
modrm 6,dst
endm
codemacro FLDENV src:M
db 9bh
segfix src
db 0d9h
modrm 4,src
endm
codemacro FNOP
db 9bh
dw 0d0ddh
endm
FWAIT equ WAIT


71
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SHARE.MEM Normal file
View File

@@ -0,0 +1,71 @@
;*****************************************************
;*
;* Shared Memory Routines
;*
;*****************************************************
;===========
share_entry: ; share memory
;===========
; input: DX->SPB in u_wrkseg
;
; +-----+-----+-----+-----+-----+-----+
; SPB | OPD | RPD | START |
; +-----+-----+-----+-----+-----+-----+
;
; Obtain new MD
push dx ! call getmd ! pop dx
jcxz se_c
jmp se_err2
se_c: mov bp,bx ; BP = New MD
push ds ! mov ds,u_wrkseg
mov di,dx ! mov bx,spb_opd[di] ; BX = Owner PD
mov si,spb_rpd[di] ; SI = Requestor PD
mov dx,spb_start[di] ; DX = start paragraph
pop ds
cmp bx,0 ! jne se_r
mov bx,rlr
se_r: cmp si,0 ! jne se_s
mov si,rlr
se_s: cmp si,bx ! je se_ge
lea di,(p_mem-ms_link)[bx]
se_go: mov di,ms_link[di]
cmp di,0 ! je se_err
cmp ms_start[di],dx ! jne se_go
; DI = Owner MS to share
; SI = Requestor PD
; DX = Start
; BP = New MD
mov bx,bp
mov ms_start[bx],dx
mov ax,ms_length[di] ! mov ms_length[bx],ax
mov ax,ms_flags[di] ! mov ms_flags[bx],ax
mov ax,ms_mau[di] ! mov ms_mau[bx],ax
mov di,bx ! mov bx,ax
push ds ! mov ds,m_start[bx]
sub bx,bx ! mov cl,.0
se_n: cmp cl,0 ! je se_err1
add bx,satlen ! dec cl
cmp sat_start[bx],dx ! jne se_n
inc sat_nall[bx]
; place new MS on RPD p_mem
pop ds ! lea bx,p_mem[si]
mov dx,ms_mau[di]
se_m: mov si,ms_link[bx]
cmp si,0 ! je se_link
cmp dx,ms_mau[si] ! je se_link
mov bx,si ! jmps se_m
se_link: mov ms_link[di],si
mov ms_link[bx],di
jmps se_ge
se_err1: pop ds ! mov bx,bp ! call freemd
se_err: mov cx,e_no_memory
se_err2: mov bx,0ffffh ! ret
se_ge: sub bx,bx ! mov cx,bx ! ret


43
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SUP.A86 Normal file
View File

@@ -0,0 +1,43 @@
include cpyright.def
;*****************************************************
;*
;* MP/M or CCP/M Supervisor Module
;*
;*****************************************************
eject ! include system.def
eject ! include modfunc.def
eject ! include modtab.def
eject ! include xioscb.def
eject ! include pd.def
eject ! include err.def
eject ! include qd.def
eject ! include fcb.def
eject ! include acb.def
eject ! include enttab.def
eject ! include mem.def
eject ! include mpb.def
eject ! include clicb.def
eject ! include rsp.def
eject ! include pcb.def
eject ! include cmdh.def
eject ! include char.def
eject ! include vccb.def
eject ! include uda.def
eject ! include init.sup
eject ! include supif.sup
eject ! include sysfunc.sup
eject ! include command.sup
eject ! include load.sup
eject ! include parse.sup
eject ! include rpl.sup
eject ! include patch.cod
eject ! include basep.fmt
eject ! include lstk.fmt
eject ! include vec.fmt
eject ! include uda.fmt
eject ! include sysdat.dat
eject ! include data.bdo
eject ! include xiosdat.fmt
eject ! end


361
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SUPIF.SUP Normal file
View File

@@ -0,0 +1,361 @@
;*****************************************************
;*
;* SUPERVISOR INTERFACE ROUTINES
;*
;*****************************************************
;=========
user_entry:
;=========
; User Entry Point - enter here from a INT 224
;
; REGISTER USAGE
; ENTRY EXIT
; ----- ----
; CL - Function Code AX - Copy of BX
; DX - Param BX - Return
; DS - Seg Addr CX - Error Code
; ES - Segment Return
;
; DS,SI,DI,BP preserved through call
;
; SETUP FOR MPM ENVIRONMENT
; -------------------------
; contents of users stack
; Flags
; CS
; IP <- u_stack_ss,_sp
; DS = Sysdat Segment
; ES -> user_data_area (UDA)
; DX -> function parameter
; u_wrkseg == user's DS
; u_retseg == user's ES
;interrupts are off
;set up MPM,CCPM environment
cld ! mov ax,ds ;AX = user's DS
mov ds,sysdat
mov bx,rlr
mov ds,p_uda[bx] ;DS = UDA segment
mov ds:u_retseg,es ;save user's ES
;U_INSYS is count of times
;through this entry point
cmp ds:u_insys,0 ! jne noswt ;change stacks to UDA stack
;if U_INSYS = 0
;otherwise leave stack alone
;U_WRKSEG where is user's entry DS
;is saved
mov ds:u_wrkseg,ax ;wipe out earlier u_wrkseg
mov ds:u_stack_ss,ss
mov ds:u_stack_sp,sp
mov ax,ds
mov ss,ax ! mov sp,ulen ;stack starts at end of UDA
jmps uecont
noswt:
push ds:u_wrkseg ;save current u_wrkseg on UDA stack
mov ds:u_wrkseg,ax
uecont:
sti
inc ds:u_insys
mov ax,ds ! mov es,ax ;register moves are faster than
mov ds,sysdat ;push and pop, DS=SYSDAT,ES=UDA
push si ! push di ! push bp
mov u_func,cl ;record function number in UDA
xor ch,ch ;call function and do
call netchk ;netwrk chk, returns BX, ES, CX
coret:
pop bp ! pop di ! pop si
mov ax,es ;setup user's environment and return
mov ds,ax ;DS = UDA segment
mov es,ds:u_retseg ;restore ES from entry unless
;function returns a segment value
mov ax,ds:u_wrkseg ;AX = user's entry DS
cli
dec ds:u_insys ! jnz nstk ;switch back to user's stack
;if U_INSYS = 0
push bx ! push ds ! push cx ;See if process should be suspended.
mov ds,sysdat ;Since it's on its way out, it doesn't
mov bx,rlr ;own any critical regions and we can
;put it to sleep until its console is
;switched into the foreground.
mov ax,p_sflag[bx]
test ax,psf_suspend ;is this a suspendable process ?
jz coret1 ;no...
mov es,p_uda[bx] ;Set up ES = UDA
mov al,p_cns[bx]
xor ah,ah ! xor bh,bh ;get vccb's state
mov bx,ccblen ! mul bx
mov bx,ccb ! add bx,ax
mov ax, c_state[bx]
test ax,csm_suspend ;is it to be suspended now ?
jz coret1 ;no...
mov bx,rlr
push dx
mov dx, offset splr ;get suspend list for sleep_entry
mov ud_param,dx
mov cx, f_sleep ;call to RTM to place in list
xor bh,bh
mov bl,ps_ciowait ;user ciowait instead of suspend
call osif ;so the abort code will work
pop dx
coret1:
pop cx ! pop ds ! pop bx
mov ax,ds:u_wrkseg
mov es,ds:u_retseg
coret2:
mov ss,ds:u_stack_ss
mov sp,ds:u_stack_sp
jmps ueout
nstk:
sti
pop ds:u_wrkseg ;restore previous U_WRKSEG if not
;going back to user's stack
ueout: mov ds,ax ;DS = user's entry DS
mov ax,bx ;parameter return BX = AX
inc ax
jz u_err1 ;CX=error code if AX,BX=0FFFFH
xor cx,cx ;CX always 0 if no error
u_err1:
dec ax
iret ;back to user ...
;restore interrupts as they
;were on entry
sysfunc: ; call system function
;------- -----------------------
; entry: if CH <> 0 then CH is module number
; (usually 1:SUP, 2:RTM, 3:MEM, 4:CIO, 5:BDOS)
; network check is bypassed
; if CH = 0 then network check is done
; CL = function #
; DX = arg
; BX = arg
; exit: BX = return value
; ES = segment return value
; CX = error code if BX = 0FFFFH
test ch,ch ! jz netchk ;network or local
mov ax,cx ! jmps localfunc ;in local module
illfunc: ;illegal function number
jmp i_ent
netchk:
; enter here for network check
; check for function numbers represented in function table,
; ENTTAB_TABLE. Table space is saved by making the functions
; contiguous as we check the range.
; The table has entries for functions 0-80, 98-116, 128-164.
; Numbers 70-97, 117-127, 165-255 are not in the table.
; Illegal functions in this table return the error codes
; not implemented (1) or illegal function number (2).
; Function not in the table return the illegal function number
; code.
; To add a new user function modify the files SYSDAT.DAT and
; MODFUNC.DEF as well as the ranges immediately
; below. All of the modules SUP,RTM,MEM,CIO,BDOS,SYSDAT must
; then be reassembled.
if netversion
mov ax,cx
cmp al,80 ! jbe okfunc
sub al,17 ! cmp al,81 ! jb illfunc
cmp al,99 ! jbe okfunc
sub al,11
;
; 3.1M patch for illegal function numbers 117-127
;
cmp al,100 ! jb illfunc ;117 -127 are now 89 -99
cmp al,136 ! ja illfunc
;
; end of 3.1M patch
;
endif
if not netversion
cmp cl,80 ! jbe okfunc
sub cl,17 ! cmp cl,81 ! jb illfunc ;98-116 are now 81-99
cmp cl,99 ! jbe okfunc ;128-164 are now 100-136
sub cl,11
;
; 3.1M patch for illegal functions 117-127
;
cmp cl,100 ! jb illfunc ;117 -127 are now 89 - 99
cmp cl,136 ! ja illfunc
;
; end of 3.1M patch
;
endif
okfunc:
if netversion
shl ax,1
mov si,ax
mov ax,word ptr sysent[si]
test ah,net_bit
jz localfunc
and ah, not net_bit
mov bl,module_map
test bl,netmod_bit
je localfunc
push ax
callf dword ptr .netmod
cmp al,0ffh
pop ax
je localfunc
mov ax,bx
ret
endif
if not netversion
;CL is now 0 - num entries
;- 1 in entry table
mov si,cx ! shl si,1 ;times 2 for entry table
add si,offset sysent ;AH high nibble flags
mov ax,enttab_entry[si] ;AH low nibble module
;AL function number
;within module
test ah,net_bit ! jz localfunc ;not a network function
and ah,not net_bit ;turn off network bit
mov al,module_map
test al,netmod_bit ! je localfunc ;network module is not there
push ax
callf dword ptr .netmod ;call network CL = func
cmp al,true ;if AL=0FFH do func locally
pop ax ;in addition over network
jne localfunc
mov ax,bx ! ret
endif
localfunc: ;not over the network
cmp ah,sup ! je insup ;AH=module, AL=function
mov cl,ah
mov ch,module_map ! shr ch,cl ;does module exist ?
jnc badmod
xor ch,ch ! dec cx ;make module 0 relative
shl cx,1 ! shl cx,1 ! shl cx,1 ;* 8
mov si,cx ! mov cl,al ;func # in CL
callf dword ptr module_table[si]
ret
badmod:
jmp n_imp
insup:
xor ah,ah
shl ax,1 ! mov si,ax ; mov cx,ax
jmp cs:supfunc[si]
;=====
entry: ; Supervisor module entry point
;===== -------------------------------
;
; Arrive here usually on a CALLF using address
; at SYSDAT:4. Note: flag set is handled specially.
;
; entry: if CH <> 0 then CH is module number
; (usually 1:SUP, 2:RTM, 3:MEM, 4:CIO, 5:BDOS)
; network check is bypassed
; if CH = 0 then network check is done;
; CL = function #. If CH = 0 then CL is treated
; as a function number used with an INT 224:
; it is a USER function.
; If CH is not 0 then CL is the function number
; within the module specified by CH.
; The file MODFUNC.DEF contains the equates
; used for accessing functions from within the O.S.
; These functions are INTERNAL functions.
; Note the INTERNAL functions are a superset of
; the USER functions. The equates for USER
; functions in MODFUNC.DEF have a 0 for the high byte
; forcing network checking from this entry point.
; An example: if f_conin (from MODFUNC.DEF) is
; equal to 0001H. A Console output call to this
; entry point thus result in CH = 0, CL = 1.
; DX = arg
; BX = arg
;
; exit: BX = return value
; ES = segment return value
; CX = error code if BX = 0FFFFH
cmp cx,f_flagset ! jne notfs ;flag set is exception:
mov cx,f_inflagset ;do not go over network,
call sysfunc ;make path shorter,
mov ax,bx ;parameter return BX = AX
inc ax ;AX=0FFFFH if error
jz u_err2 ;CX= error code if AX,BX=0FFFFH
xor cx,cx ;CX=0 if no error
u_err2:
dec ax ;set AX back to 0 or 0FFFFH
retf ;DS must equal system
notfs: ;data segment
;mov u_unused,cx ;save 16 bit function number
call osif ! retf
osif: ;point SUP uses to get
;to other modules
push u_wrkseg ;save current u_wrkseg
mov ax,ds
mov u_wrkseg,ax
mov ax,sysdat
mov ds,ax
call sysfunc
mov ax,u_wrkseg
mov ds,ax
pop u_wrkseg
mov ax,bx ;BX,CX are return codes
inc ax ;AX=0FFFFH if error
jz u_err3 ;CX= error code if AX,BX=0FFFFH
xor cx,cx ;CX=0 if no error
u_err3:
dec ax ;set AX back to 0 or 0FFFFH
ret
;=========
user_retf:
;=========
; If a user process does a RETF to terminate,
; the process ends here. The Load function sets up
; the default stack to point here.
mov bx,rlr
and p_flag[bx],not pf_keep+pf_tempkeep+pf_ctlc+pf_sys
mov cx,f_terminate
xor dx,dx
int osint ;make sure the terminate
;succeed by reseting the
;the keep,tempkeep,ctlc,sys flags
;======
xiosif:
;======
callf dword ptr .xiosmod ! ret
;*****************************************************
;*
;* Supervisor function table
;*
;*****************************************************
org ((offset $)+1) AND 0fffeh ;Word Boundary
supfunc dw n_imp ; 0-not implemented
dw i_ent ; 1-illegal function number
dw bver_ent ; 2-(12)get BDOS version
dw cbios_ent ; 3-(50)call bios
dw load_ent ; 4-(59)user load function
dw cli_ent ; 5-(150)CLI
dw rpl_ent ; 6-(151)Call RPL
dw parse_ent ; 7-(152)parse filename
dw sdat_ent ; 8-(154)get sysdat addr
dw tod_ent ; 9-(155)get tod addr
dw load ; 10-load function
dw over_ent ; 11-O.S. version number
dw chain_ent ; 12-(47)Program Chain
dw ser_ent ; 13-(107)return serial
dw cload_ent ; 14-chain load function


15
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SYSDAT.A86 Normal file
View File

@@ -0,0 +1,15 @@
eject ! include cpyright.def
;*****************************************************
;*
;* System Data Area - Initialized Data
;*
;*****************************************************
eject ! include system.def
eject ! include pd.def
eject ! include uda.def
eject ! include qd.def
eject ! include modfunc.def
eject ! include sysdat.dat
eject ! include data.bdo


587
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SYSDAT.DAT Normal file
View File

@@ -0,0 +1,587 @@
;*****************************************************
;*
;* System Data Area
;*
;*****************************************************
CSEG
org 0ch
;dev_ver
db 6 ;development system data version
;SYSDAT.CON has 16 byte code segment
DSEG
org 0
;
;This data is initialized by GENCCPM
;
;Module Table - contains the FAR CALL addresses
; of each module for their initialization
; and entry routines.
;
; +---+---+---+---+---+---+---+---+
; | entry | initialize |
; +---+---+---+---+---+---+---+---+
;
; entry init
; ----- ----
module_table equ dword ptr (offset $)
supmod equ (offset $)
dw 3,0, 0,0 ;SUP
rtmmod equ (offset $)
dw 3,0, 0,0 ;RTM
memmod equ (offset $)
dw 3,0, 0,0 ;MEM
ciomod equ (offset $)
dw 3,0, 0,0 ;CIO
bdosmod equ (offset $)
dw 3,0, 0,0 ;BDOS
xiosmod equ (offset $)
dw 0C03H,0, 0C00H,0 ;XIOS
netmod equ (offset $)
dw 3,0, 0,0 ;NET
dispatcher equ (offset $)
dw 0,0 ;far dispatcher (does IRET)
rtm_pdisp equ (offset $)
dw 0,0 ;far dispatcher (does RETF)
; location in memory of MP/M-86 or CCP/M-86
osseg dw 1008h ;1st parag. of MP/M-86 or CCP/M
rspseg dw 0 ;segment of first RSP
endseg dw 0 ;1st parag. outside of MP/M or CCP/M
module_map db 03fh ;bit map of modules that exist
; in this system. low order bit
; corresponds to 1st module in
; module table. If bit is on,then
; module exists.
; some answers to GENCCPM questions
ncns db 4 ;# system console devices
nlst db 1 ;# system list devices
nccb db 5 ;# character control blocks
nflags db 20h ;# flags
srchdisk db 1 ;system disk
mmp dw 04000h ;Max Memory per process
nslaves db 0 ;Number of network requestors
dayfile db 0 ;if 0ffh,display command info
tempdisk db 1 ;Temporary disk
tickspersec db 60 ;Number of ticks per second
; data lists created by GENCCPM
free_root dw 0 ;locked unused list
ccb dw 0 ;addr. Console Ctrl Blk Table
flags dw 0 ;addr. Flag Table
mdul dw 020h ;Mem descr. Unused List
mfl dw 0 ;Memory Free List
pul dw 014h ;Proc. descr. Unused List
qul dw 020h ;QCB Unused List
;MAU for queue buffer info
qmau dw 0 ;link
dw 0 ;start segment
dw 400h ;length
dw 0 ;plist
;
;This data is initialized at Assembly time
;
rlr dw initpd ;Ready List Root
dlr dw 0 ;Delay List Root
drl dw 0 ;Dispatcher Ready List
plr dw 0 ;Poll List Root
scl dw 0 ;Shared Code List
thrdrt dw initpd ;Process Thread Root
qlr dw mxloadqd;Queue List Root
mal dw 0 ;Memory Alloc List
; Version Information
version dw unknown ;addr. version str in SUP code segment
;set by GENCCPM if CCP/M
if mpm
bvernum dw 01431h ;MPM-86 w/BDOS v3.1
osvernum dw 01431h ;MPM-86 V3.1
endif
if ccpm
bvernum dw 01431h ;CCP/M w/BDOS 3.1
osvernum dw 01421h ;CCP/M V2.1
endif
; Time of Day Structure
tod rw 0
tod_day dw 067EH ;day since 1/1/78 (09 Jul 82)
tod_hr db 12h ;hour of day
tod_min db 00h ;minute of hour
tod_sec db 00h ;second of minute
; info from XIOS
ncondev db 0 ;# console devs in XIOS
nlstdev db 0 ;# character devs in XIOS
nciodev db 0 ;# character i/o devices
; supported by XIOS.
lcb dw 0 ; list control block address
openvec dw 0 ; open file vector
lock_max db 20h ; Max Locked Records/process
open_max db 20h ; Max Open Files/process
owner8087 dw 0 ; no one owns it initially
rw 1 ; RESERVED
cmod db 0ffh ; BDOS Compatibility
ndp8087 rb 1 ; RESERVED
err_intercept dw 0,0 ; BDOS does a callf here
; to print error msgs,
; if second word is <> 0
slr dw offset mem_spb ; Sync List Root
dw 0,0,0 ; RESERVED
db 0 ; RESERVED
xpcns db 0 ; # physical consoles
iofs87 rw 1 ; address of NDP interrupt
iseg87 rw 1 ; vector.
sysvec87_of rw 1 ; system exception handler's
sysvec87_sg rw 1 ; segment and offset.
splr dw 0 ; suspend list root
; SYSENT Table - MP/M-86, CCP/M-86 system function information
; The supervisor calls the appropriate module
; through this table.
;
; Low Byte High Byte
; +----+----+--------+
; |function |flgs|mod|
; +----+----+--------+
;
; flgs - 001h - network intercept
; if on, the network module is called
; first, on return, either the function
; is called or it is considered complete
; depending on the return.
; mod - module number (0-15)
; function- function to call within module
; note: sup function 0 returns not the
; implemented error code to the caller,
; and sup function 1 returns the illegal
; function error code.
; standard CPM-2 functions
; func, module
org ((offset $) + 1) and 0fffeh
sysent db 0, rtm ; 0-system reset
db 0, cio ; 1-conin
db 1, cio ; 2-conout
db 0, sup ; 3-raw conin/aux in
db 0, sup ; 4-raw conout/aux out
db 4, cio or net_bit ; 5-list out
db 5, cio ; 6-raw conio
db 0, sup ; 7-getiobyte
db 0, sup ; 8-setiobyte
db 6, cio ; 9-conwrite
db 7, cio ; 10-conread
db 8, cio ; 11-constat
db 2, sup or net_bit ; 12-get version
db 0, bdos or net_bit ; 13-diskreset
db 1, bdos or net_bit ; 14-diskselect
db 2, bdos or net_bit ; 15-file open
db 3, bdos or net_bit ; 16-file close
db 4, bdos or net_bit ; 17-search first
db 5, bdos or net_bit ; 18-search next
db 6, bdos or net_bit ; 19-file delete
db 7, bdos or net_bit ; 20-file read seq
db 8, bdos or net_bit ; 21-file write seq
db 9, bdos or net_bit ; 22-file make
db 10, bdos or net_bit ; 23-file rename
db 11, bdos or net_bit ; 24-login vector
db 12, bdos ; 25-get def disk
db 13, bdos ; 26-set dma
db 14, bdos or net_bit ; 27-get alloc vector
db 15, bdos or net_bit ; 28-write protect
db 16, bdos or net_bit ; 29-get r/0 vector
db 17, bdos or net_bit ; 30-set file attr.
db 18, bdos or net_bit ; 31-get disk parm block
db 19, bdos ; 32-user code
db 20, bdos or net_bit ; 33-file read random
db 21, bdos or net_bit ; 34-file write random
db 22, bdos or net_bit ; 35-file size
db 23, bdos or net_bit ; 36-set random record
db 24, bdos or net_bit ; 37-reset drive
db 25, bdos or net_bit ; 38-access drive
db 26, bdos or net_bit ; 39-free drive
db 27, bdos or net_bit ; 40-file write random w/zero fill
;CPM-3 extensions
db 0, sup ; 41-Test and Write (NOT IMPLEMENTED)
; Would be BDOS func # 28
db 28, bdos or net_bit ; 42-Lock Record
db 29, bdos or net_bit ; 43-Unlock Record
db 30, bdos ; 44-Set Multi-sector
db 31, bdos or net_bit ; 45-Set Bdos Error Mode
db 32, bdos or net_bit ; 46-Get Disk Free Space
db 12, sup or net_bit ; 47-Chain to Program
; In CP/M-86 BDOS func # 34
db 33, bdos ; 48-Flush Buffers
db 1, sup ; 49-
;CPM-86 extensions
db 3, sup ; 50-call xios
db 34, bdos ; 51-set dma base
db 35, bdos ; 52-get dma
db 0, mem ; 53-get max mem
db 1, mem ; 54-get abs max mem
db 2, mem ; 55-alloc mem
db 3, mem ; 56-alloc abs mem
db 4, mem ; 57-free mem
db 5, mem ; 58-free all mem
db 4, sup or net_bit ; 59-load
db 1, sup ; 60-
db 1, sup ; 61-
db 1, sup ; 62-
db 1, sup ; 63-
;CP/NET functions
db 64, net or net_bit ; 64-network login
db 65, net or net_bit ; 65-network logoff
db 66, net or net_bit ; 66-network send msg
db 67, net or net_bit ; 67-network rcv msg
db 68, net or net_bit ; 68-network status
db 69, net or net_bit ; 69-get network config addr
db 70, net or net_bit ; 70-set Compatibility attributes
db 71, net or net_bit ; 71-get network server config table
db 72, net or net_bit ; 72-set network error mode
db 73, net or net_bit ; 73-attach network
db 74, net or net_bit ; 74-detach network
db 75, net or net_bit ; 75-set message buffer size
db 76, net or net_bit ; 76-get network time and date
db 77, net or net_bit ; 77-get network parameter table
db 1, sup ; 78-unused
db 1, sup ; 79-unused
db 1, sup ; 80-unused
;CP/M-3 extensions
db 36, bdos or net_bit ; 98-Reset Alloc Vector
db 37, bdos or net_bit ; 99-Truncate File
db 38, bdos or net_bit ;100-Set Dir Label
db 39, bdos or net_bit ;101-Return Dir Label
db 40, bdos or net_bit ;102-Read File XFCB
db 41, bdos or net_bit ;103-Write File XFCB
db 42, bdos ;104-Set Date and Time
db 43, bdos ;105-Get Date and Time
db 44, bdos or net_bit ;106-Set Default Password
db 13, sup ;107-Return Serial Number
db 0, sup ;108-(not implemented)
db 25, cio ;109-Get/Set Console Mode
db 26, cio ;110-Get/Set Output Delimiter
db 27, cio ;111-Print Block
db 28, cio or net_bit ;112-List Block
db 1, sup ;113-reserved
db 1, sup ;114-reserved
db 1, sup ;115-reserved
db 45, bdos ;116-Set File_Date_Time
; MP/M functions
db 6, mem ;128-mem req
db 6, mem ;129-(same function as 128)
db 7, mem ;130-mem free
db 1, rtm ;131-poll device
db 2, rtm ;132-flag wait
db 3, rtm ;133-flag set
db 4, rtm or net_bit ;134-queue make
db 5, rtm or net_bit ;135-queue open
db 6, rtm or net_bit ;136-queue delete
db 7, rtm or net_bit ;137-queue read
db 8, rtm or net_bit ;138-cond. queue read
db 9, rtm or net_bit ;139-queue write
db 10, rtm or net_bit ;140-cond. queue write
db 11, rtm ;141-delay
db 12, rtm ;142-dispatch
db 13, rtm ;143-terminate
db 14, rtm or net_bit ;144-create process
db 15, rtm ;145-set priority
db 9, cio ;146-console attach
db 10, cio ;147-console detach
db 11, cio ;148-set def console
db 12, cio ;149-console assign
db 5, sup ;150-CLI
db 6, sup ;151-call RPL
db 7, sup ;152-parse filename
db 13, cio ;153-get def console
db 8, sup ;154-sysdat addr
db 9, sup ;155-time of day
db 16, rtm ;156-get PD addr
db 17, rtm ;157-abort process
; MPM II extensions
db 15, cio or net_bit ;158-attach list
db 16, cio or net_bit ;159-detach list
db 17, cio or net_bit ;160-set list dev
db 18, cio or net_bit ;161-Cond. Attach list
db 19, cio ;162-Cond. Attach Console
db 11, sup or net_bit ;163-MP/M Version Number
db 20, cio or net_bit ;164-get list dev
; Initialized Queues
org ((offset $) + 1) and 0fffeh
mxloadqd dw mxdiskqd
db 0,0
dw qf_keep+qf_mx
db 'MXLoad '
dw 0,1,0,0,1,0,0
mxloadqpb db 0,0
dw mxloadqd,1,0
; db 'MXLoad '
; Data Used by Load Program
org ((offset $) + 1) and 0fffeh
lod_uda dw 0
lod_lstk dw 0
lod_basep dw 0
lod_nldt dw 0
lod_pd dw 0
lod_fcb rs 36
lod_indma dw 0
lod_nrels db 0
lod_chain db 0
lod_user db 0
lod_disk db 0
lod_fifty db 0
lod_8080 db 0
lod_lbyte db 0
lod_fixrec dw 0
lod_ndp db 0
lod_suspnd db 0
lod_fixrec1 dw 0
lod_dma rb dskrecl
ldtab rb ldtabsiz
cli_dma_ofst rw 1
cli_dma_seg rw 1
cli_pflag rw 1
cli_chain rb 1
cli_term rb 1
cli_dma rb dskrecl ;dma buffer
;copy of user's clicb
cli_net rb 1 ;net
cli_ppd rw 1 ;parent PD
cli_cmdtail rb 129 ;command sent
rb 1
cli_fcb rb fcblen+1 ;internal FCB
cli_cuspqpb db 0,0 ;QPB of command
dw 0,0
dw offset cli_ppd
db '$$$$$$$$'
cli_acb db 0,0 ;cns,match
dw 0 ;pd
db '$$$$$$$$' ;name
cli_pcb dw offset cli_cmdtail ;parse
dw offset cli_fcb ;ctl bk
cli_pd dw 0 ;pd of load prog
cli_err dw 0 ;error return
cli_bpage dw 0 ;base page
cli_lddsk db 1 ;load disk
;parent information
cli_cns db 0 ;pd.p_cns save
cli_user db 0 ;pd.p_dsk save
cli_dsk db 0 ;pd.p_user save
cli_err_mode db 0 ;u_error_mode save
cli_dfil db 0 ;dayfile flag
;
;System Initialization Variables
;
initpd dw 0 ;link
dw 0 ;thread
db ps_run ;stat
db 1 ;prior
dw pf_sys+pf_kernal;flag
db 'Init ' ;name
dw unknown ;uda segment
db 0 ;disk
db 0 ;user
db 0,0 ;ldsk,luser
dw 0 ;mem
dw 0 ;dvract
dw 0 ;wait
db 0,0 ;org,net
dw 0 ;parent
db 0 ;cns
db 0 ;abort
db 0,0 ;cin,cout
db 0 ;lst
db 0,0,0 ;sf3,4,5
rb 4 ;reserved
dw 0,0 ;pret,scratch
;User Data Area of Init process
;paragraph aligned
org ((offset $)+0fh) AND 0fff0h
inituda rb ulen
init_tos rw 0
org offset inituda + ud_insys
db 1 ;keep the SUP from doing stack
org offset init_tos ;switches
; RTM data
; is word aligned from init uda
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch
dsptchtos rw 0
indisp db false ;?currently in dispatch?
intflag db 0 ;if 0, interrupts not enabled -
;not implemented
es_sav dw 0 ;(staying word aligned)
bx_sav dw 0
ax_sav dw 0
; MEM Data
beststart dw 0
bestlen dw 0
bestsi dw 0
bestmau dw 0
currmau dw 0
currsi dw 0
currmpb dw 0,0,0,0,0
; **3.1M**
;
; save area and stack for memory manager local stack switch
;
mem_save_sp dw 0
mem_save_ss dw 0
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
dw 0cccch,0cccch,0cccch,0cccch
mem_tos rw 0
;
; **3.1M**
;
; SYNC Parameter Blocks
; The MEM ENTRY: point uses the following for
; mutual exclusion and recursion.
mem_cnt db 0 ;how many times a process has recursivly
;called the memory manager
mem_spb dw q_spb ;link Mem Sync Parameter Block
dw 0 ;owner
dw 0 ;wait
dw 0 ;next
; The queue sub-system in the RTM uses the following
; structure for mutual exclusion
q_spb dw cli_spb ;link Queue Sync Parameter Block
dw 0 ;owner
dw 0 ;wait
dw 0 ;next
; The CLI uses the CLI_SPB for mutual exclusion
cli_spb dw thrd_spb;link CLI Sync Parameter Block
dw 0 ;owner
dw 0 ;wait
dw 0 ;next
; When the thread is accessed, the THRD_SPB must be owned
; first.
thrd_spb dw msg_spb ;link Thread Sync Parameter Block
dw 0 ;owner
dw 0 ;wait
dw 0 ;next
; Currently the order in which the SYNCs must be obtained if
; more than one is needed is:
; CLI
; QUEUE ;called by CLI for RSPs
; MEM ;called by make queue
; THREAD ;used from the MEM module
; The SYNCs must be released in reverse order
; MSG_SPB is used by the BDOS to protect the BDOS error message
; buffer. MSG_SPB is in DATA.BDO


309
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SYSENT.RTM Normal file
View File

@@ -0,0 +1,309 @@
;********************************************************
;* *
;* SYSTEM ENTRY FUNCTIONS *
;* *
;********************************************************
;========== =========================
poll_entry: ; Poll device - DL=device
;========== =========================
mov ax,rlr
mov bx,ax
mov p_wait[bx],dx
mov dx,offset plr
mov bl,ps_poll
jmp sleep_entry
;=========== ===================
delay_entry: ;Delay - DX = ticks
;=========== ===================
mov bx,rlr
mov p_stat[bx],ps_delay
mov u_dparam,dx
xor bx,bx ;return success after coming back into
jmp dsptch ;context from the dispatcher
;=============== ==============
dispatch_entry: ;Call dispatch
;=============== ==============
xor bx,bx ;return success ala DELAY_ENTRY:
jmp pdisp
;=============== ===========================
set_prior_entry: ;Set Priority - DX=priority
;=============== ===========================
mov bx,rlr
mov p_prior[bx],dl
xor bx,bx ;return success ala DELAY_ENTRY:
jmp pdisp
;======== ==================
pd_entry: ;Return addr of PD
;======== ==================
mov u_retseg,ds
mov bx,rlr
ret
;================ ============================
creat_proc_entry: ;Create Process - DX->new PD
;================ ============================
call proc_creat ! jmp pdisp
;=========== ==============================
sleep_entry: ;Put Calling PD on System List
;=========== ==============================
; entry: DX = list root to sleep on
; BL = sleep status passed to the dispatcher in
; the PD.P_WAIT field and becomes the PD.STATUS
; when sleeping
; interrupts are typically off to ensure
; the PD sleeps on the specified list
; before another process runs.
; exit: BX = 0 to indicate success after return from dispatcher
; if entered with interrupts off the process will return
; from the dispatcher with them still off
mov ax,rlr ! mov si,ax
mov ax,dx ! mov u_dparam,ax
mov p_scratch[si],bl
mov p_stat[si],ps_sleep
xor bx,bx
jmp dsptch
;============ ==============================
wakeup_entry: ;wakeup top PD in System List
;============ ==============================
; entry: DX = List Root Address
; exit: first PD on list is the last entry on the DRL
; Puting the process on the end of the DRL allows the
; process to run before equal priority processes waking up
; from flag sets, i.e., interrupts.
; To work, the dispatcher must disable interrupts
; from when the last process on the DRL is placed on the
; RLR to when the process is back in context and
; turns on the interrupt flag.
pushf ! cli
mov bx,dx ! mov si,[bx] ;SI=PD to wake
test si,si ! jz wke_out ;check for a process to wake up
mov ax,p_link[si] ;take PD off list
mov [bx],ax ;set list root to next PD
mov di,offset drl - p_link ;go to the end of DRL
xor ax,ax ;AX=0
wu_drl:
cmp p_link[di],ax
je wu_drlend
mov di,p_link[di] ! jmps wu_drl
wu_drlend:
mov p_link[di],si ;make waking PD last on DRL
mov p_link[si],ax ;0 the end of the DRL
mov p_stat[si],ps_run ;new status
call pdisp
wke_out:
popf ! ret
;========== ========================
sync_entry: ;Obtain mutual exclusion
;========== ========================
; entry: interrupts on or off
; BX = Sync Parameter Block
; exit: ownership of Sync Parameter Block,
; interrupt state unchanged
; Obtain ownership of mutually exclusive section of code
; without using MXqueues. A process only sleeps temporarily
; on a SYNC structure. A process that obtains the
; SYNC must call UNSYNC when finished with the
; protected data structure and before sleeping or
; calling SYNC with on a different SYNC structure.
mov ax,rlr
mov si,ax ;AX=SI calling process
pushf ! cli
xchg ax,sy_owner[bx] ;AX=owner
test ax,ax ;0 nobody owns it
jz s_got_it
cmp ax,si ;do we already own it ?
je s_got_it
mov sy_owner[bx],ax ;restore owner
lea dx,sy_wait[bx] ;list to sleep on
mov bl,ps_sync ;sleep with sync status
call sleep_entry
;awaken with sync ownership
s_got_it:
popf ! ret ;we own the SPB
;============ ==========================
unsync_entry: ;release mutual exlclusion
;============ ==========================
;
; entry: BX = Sync Parameter Block
; exit: SYNC_OWNER changed to the PD in the SY_NEXT
; field if SY_NEXT is non 0. The PD in the SY_NEXT
; must have a 0 P_LINK. If SY_NEXT=0, the SY_OWNER
; field is changed to the first PD on the SY_WAIT
; list. If SY_WAIT is 0, SY_OWNER becomes 0.
mov ax,rlr
cmp ax,sy_owner[bx] ;do we own it ?
jne us_ret
xor ax,ax
pushf ! cli ;no other process can change SYNC or DRL
xchg ax,sy_next[bx] ;0 SY_NEXT field
test ax,ax ;assigned next process ?
jz us_wait
mov si,ax
jmps us_own
us_wait:
mov si,sy_wait[bx] ;give the sync to first waiting process
test si,si ;no waiting PD ?
jz us_zero
mov ax,p_link[si]
mov sy_wait[bx],ax
mov p_link[si],0
us_own:
mov p_stat[si],ps_run
mov ax,drl
mov p_link[si],ax ;put process on DRL
mov drl,si
us_zero:
mov sy_owner[bx],si ;SI=0 or process to now own sync
popf ;allow interrupts
us_ret: ;wait for next dispatch
ret
;================= ============================
assign_sync_entry: ;give away mutual exlclusion
;================= ============================
; interrupts on
; entry:
; BX = Sync Parameter Block
; DX = address of list root, assign
; SPB to first PD on list
; exit: none
;
mov ax,rlr
cmp sy_owner[bx],ax ;check that we own the resource
jne as_ret
mov si,dx ;SI=list root
pushf ! cli ;no other process can run
mov di,[si] ;get first PD from list
test di,di ;test for 0 list
jz as_done
mov ax,p_link[di] ;take PD off list
mov [si],ax
mov p_link[di],0 ;0 link of NEXT PD
;status is still PS_SLEEP.
;if TEMPKEEP is on ABORT_SPEC
;will just turn on CTLC flag.
;if no TEMPKEEP, ABORT_SPEC
;will not find PD on the U_DPARAM
;list and will fail.
mov sy_next[bx],di ;see UN_SYNC_ENTRY
;for use of SYNC_NEXT field
as_done:
popf
as_ret:
ret
;==============
no_abort_entry:
;==============
; Keep the calling process from being aborted by
; using the PF_TEMPKEEP flag.
; Turn on the PF_TEMPKEEP flag and
; increment the P_TKEEPCNT.
; entry: none
; exit: PD fields altered
; interrupt state unaltered
; This code must be exclusive of ABORT_SPEC's testing
; and acting on the PD flags.
mov ax,rlr
mov si,ax
na_spec:
cmp p_tkcnt[si],0
jne na_saved
test p_flag[si],pf_tempkeep
jz na_saved
or p_tkcnt[si],80h ;save orignal TEMPKEEP in MSB
na_saved: ;until rest of O.S. is fixed
or p_flag[si],pf_tempkeep
inc p_tkcnt[si]
ret
;===================
no_abort_spec_entry:
;===================
; Keep the specified process from being aborted by setting
; its TEMPKEEP flag.
; entry: DX=PD address, interrupts off
; exit: PD TEMPKEEP turned on, TKCNT incremented
mov si,dx
jmps na_spec
;==============
ok_abort_entry:
;==============
; Allow the calling process to be aborted if
; the PF_TEMPKEEP flag is keeping it from being aborted.
; P_TKCNT is decremented in the PD, if P_TKCNT
; is = 0 then PF_TEMPKEEP is turned off and PF_CTLC
; flag is tested.
; Interrupts should be turned off if an NO_ABORT_SPEC
; can be performed on a process running this code.
; entry: none
; exit: PD fields altered
mov ax,rlr
mov si,ax
mov al,p_tkcnt[si]
and al,07FH ;high bit is original TEMPKEEP
dec al
jz oa_restore ;assume
dec p_tkcnt[si] ;no borrow from MSB
ret
oa_restore:
if netversion
and p_tkcnt[si],80H ;was TEMPKEEP on originally ?
endif
if not netversion
test p_tkcnt[si],80h
endif
jnz oa_ret ;if it was don't chk CTLC here
;turn off TEMPKEEP
and p_flag[si],not pf_tempkeep
test p_flag[si],pf_ctlc
jz oa_ret
mov dx,0ffffh ;if PF_CTLC is set ok to
if netversion
push si
call terminate_entry ;terminate even if SYS PD,
pop si
endif ;see ABT_CHK in ABORT.RTM
;terminate may fail if
;KEEP was set while
if not netversion
call terminate_entry
endif
oa_ret: ;TEMPKEEP was also set.
mov p_tkcnt[si],0
ret


174
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SYSFUNC.SUP Normal file
View File

@@ -0,0 +1,174 @@
;*****************************************************
;*
;* SYSTEM ENTRY FUNCTIONS
;*
;*****************************************************
;===== ==========================
n_imp: ; Function not implemented
;===== ==========================
mov cx,e_not_implemented
mov bx,0ffffh ! ret
;==== =========================
i_ent: ; Illegal System Function
;==== =========================
mov cx,e_bad_entry
mov bx,0ffffh ! ret
;======= ====================
bver_ent: ; Get BDOS Version #
;======= ====================
mov bx,bvernum ! xor cx,cx ! ret
;======= ====================
over_ent: ; Get O.S. Version #
;======= ====================
mov bx,osvernum ! xor cx,cx ! ret
;if mpm
;
;========= ================== ============
;cbios_ent: ; Direct BIOS call MPM 2.x ONLY
;========= ================== ============
;
; mov si,dx
; push ds ! mov ds,u_wrkseg
; mov al,[si] ! mov cx,1[si]
; mov dx,3[si] ! pop ds
; cmp al,1 ! ja goxios ;if BOOT,WBOOT; terminate
; mov cx,f_terminate
; mov dx,0 ! jmp osif
;goxios:
; cmp al,7 ! jbe gx1 ;7=reader input
; cmp al,15 ! je gx1 ;15=list status
; mov bx,0ffffh ! mov cx,e_bad_entry
; ret
;gx1: mov bx,rlr
; cmp al,4 ! ja xlst ;4=console output
; mov dl,p_cns[bx]
; cmp al,4 ! je jxio
; mov cl,dl ! jmps jxio
;
;xlst: cmp al,6 ! je jxio
; cmp al,7 ! je jxio
; mov dl,p_lst[bx]
; cmp al,15 ! jne jxio
; mov cl,dl
;jxio: sub al,2 ! mov ah,0
; jmp xiosif
;endif ;end of MP/M direct BIOS call
;if ccpm ;CCP/M direct BIOS call
;========= ================== =============
cbios_ent: ; Direct BIOS call CCPM 2.x ONLY
;========= ================== =============
; DI = 0 if last call was also func 50.
; DI = 0ffffh if it wasn't
; xor di,di
; cmp u_func,50
; je c_next50
; dec di
c_next50:
; mov u_func,50
mov si,dx
mov bp,ds ;user register for speed
mov ds,u_wrkseg
mov al,[si] ! mov cx,1[si]
mov dx,3[si]
mov ds,bp ;DS=SYSDAT
cmp al,2 ! jne not_consts ;optimize constat
; test di,di ;DI=0 if last call was func 50
; jnz go_cio
; mov si,rlr
; mov bl,ncns ;is it a virtual console ?
; cmp bl,p_cns[si]
; jae go_cio
;get_status:
; mov si,u_conccb ;if it was U_CCB is valid
; xor bx,bx
; cmp c_nchar[si],0
; jnz s_gotchar
; mov bl,c_numchars[si] ;number of chars in VINQ
; jmps s_quick
go_cio:
mov cx,f_ciostat ;doesn't change console mode
call osif
;s_quick:
test bl,bl ! jz x_cs ;returns 1 or 0 (or char count)
;s_gotchar:
mov bx,0ffh ;BIOS returns 0ffh or 0
x_cs:
ret
not_consts:
cmp al,4 ! jne not_conout ;console output
mov dl,cl ;character to send
mov cx,f_rconout
jmp osif
not_conout:
cmp al,1 ! ja goxios
mov cx,f_terminate ;cold or warm boot
mov dx,0 ! jmp osif
goxios:
cmp al,7 ! jbe gx1 ;BIOS 2-7 and 15 are ok
cmp al,15 ! je gx1
mov bx,0ffffh ! mov cx,e_bad_entry
ret
gx1:
cmp al,3 ! jne not_conin ;console input
mov cx,f_rconin
jmp osif ;BIOS return in AL and BL
not_conin:
cmp al,5 ! jne not_listout
mov dl,cl
mov cx,f_lstout
jmp osif
not_listout:
cmp al,6 ! jne not_auxout
mov ax,io_auxout
jmp xiosif
not_auxout:
cmp al,7 ! jne not_auxin
mov ax,io_auxin
jmp xiosif
not_auxin:
mov ax,io_listst ;when we move this to CIO
jmp xiosif ;check for ownership
;endif ;end of CCP/M direct BIOS
;======== ==============================
sdat_ent: ; Ret Addr of System Data Area
;======== ==============================
mov u_retseg,ds
xor bx,bx ! mov cx,bx ! ret
;======= ============================
tod_ent: ; Return current Time of Day
;======= ============================
; copy tod struct into user area
push es ! mov es,u_wrkseg
mov di,dx
mov si,offset tod ! mov cx,todlen
rep movsb
pop es ! xor cx,cx ! mov bx,cx ! ret
;======= ======================
ser_ent: ; Return Serial Number
;======= ======================
; copy serial field into user area
push es ! mov es,u_wrkseg
mov di,dx ! mov si,offset serial
push ds ! mov ax,cs ! mov ds,ax
mov cx,3 ! rep movsw
pop ds ! pop es
xor cx,cx ! mov bx,cx ! ret


25
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/SYSTEM.DAT Normal file
View File

@@ -0,0 +1,25 @@
;*****************************************************
;*
;* SYSTEM DEFINITIONS
;*
;*****************************************************
true equ 0ffffh ; value of TRUE
false equ 0 ; value of FALSE
;unknown equ 0 ; value to be filled in
dskrecl equ 128 ; log. disk record len
pnamsiz equ 8 ; size of process name
qnamsiz equ pnamsiz ; size of queue name
;fnamsiz equ pnamsiz ; size of file name
;ftypsiz equ 3 ; size of file type
mpmint equ 224 ; int vec for mpm ent.
;debugint equ mpmint+1 ; int vec for debuggers
ulen equ 0100h ; size of uda
pdlen equ 030h ; size of Process Descriptor
;todlen equ 5 ; size of Time of Day struct
;flag_tick equ 1 ; flag 0 = tick flag
;flag_sec equ 2 ; flag 1 = second flag
;flag_min equ 3 ; flag 2 = minute flag
ldtabsiz equ 0aah ; ldtablen=11, 10 entries


48
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/TICK.SUP Normal file
View File

@@ -0,0 +1,48 @@
;*****************************************************
;*
;* TICK Process
;*
;*****************************************************
;======
notick: ;NO ONE ON DELAY LIST
;======
mov bx,rlr ! mov es,p_uda[bx]
mov u_wrkseg,ds
;if mpm ;FIX 6 - DH - 14APR82
; mov al,io_stopclk ! call xiosif
;endif ;FIX 6 - DH - 14APR82
;if ccpm ;FIX 6 - DH - 14APR82
mov tick,false ;FIX 6 - DH - 14APR82
;endif ;FIX 6 - DH - 14APR82
tick_l: ;SOMEONE MAY BE ON DELAY LIST
;------
; flag wait on the TICK flag
mov dx,flag_tick ! mov cx,f_flagwait
int osint
; see if anyone delaying
pushf ! cli
mov bx,dlr
cmp bx,0 ! jz drl_e
; decrement # of ticks to wait
; see if done waiting
dec p_wait[bx] ! jnz n_tck
; our process is done waiting
ede: mov si,p_link[bx] ! mov dlr,si
mov p_stat[bx],ps_run
mov ax,drl ! mov p_link[bx],ax
mov drl,bx
cmp si,0 ! je drl_e
cmp p_wait[si],0 ! jne n_tck
mov bx,si ! jmps ede
n_tck: popf ! jmps tick_l
drl_e:
popf ! jmps notick


67
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/UDA.CIC Normal file
View File

@@ -0,0 +1,67 @@
;*****************************************************
;*
;* User Data Area - The User Data Area is an
;* extension of the process descriptor but it
;* travels with the user. It contains info
;* that is needed only while in context.
;*
;* While in the operating system, The Extra
;* Segment register points to the beginning
;* of the User Data Area.
;*
;*****************************************************
;u_dparam equ es:word ptr .000h ; arg to dispatch
; this area overlays part of BDOS
u_dma_ofst equ es:word ptr .002h ; BDOS dma offset
u_dma_seg equ es:word ptr .004h ; BDOS dma segment
u_func equ es:byte ptr .006h ; actual function number
;u_searchl equ es:byte ptr .007h ; BDOS search length
;u_searcha equ es:word ptr .008h ; BDOS search FCB offset
;u_searchabase equ es:word ptr .00Ah ; BDOS search user's segment
;u_dcnt equ es:word ptr .00Ch ; BDOS directory count
;u_dblk equ es:word ptr .00Eh ; BDOS directory block #
u_error_mode equ es:byte ptr .010h ; BDOS error mode
u_mult_cnt equ es:byte ptr .011h ; BDOS multi-sector count
;u_df_password equ es:byte ptr .012h ; BDOS default password
u_pd_cnt equ es:byte ptr .01Ah ; BDOS process count
uda_ovl_len equ 19h
; end of overlay area
;u_in_int equ es:byte ptr .01Bh
;u_sp equ es:word ptr .01Ch ; save register area
;u_ss equ es:word ptr .01Eh
;u_ax equ es:word ptr .020h
;u_bx equ es:word ptr .022h
;u_cx equ es:word ptr .024h
;u_dx equ es:word ptr .026h
;u_di equ es:word ptr .028h
;u_si equ es:word ptr .02Ah
;u_bp equ es:word ptr .02Ch
u_wrkseg equ es:word ptr .02Eh ; curr seg addr of buf
u_retseg equ es:word ptr .030h ; usr ES return
;u_ds_sav equ es:word ptr .032h ;\
;u_stack_sp equ es:word ptr .034h ; usr stack segment
;u_stack_ss equ es:word ptr .036h ; usr stack pointer
;u_ivectors equ es:word ptr .038h ; save int 0-4
;u_es_sav equ es:word ptr .04Ch ; > Used during interrupts
;u_flag_sav equ es:word ptr .04Eh ;/
;u_initcs equ es:word ptr .050h
;u_initds equ es:word ptr .052h
;u_inites equ es:word ptr .054h
;u_initss equ es:word ptr .056h
;u_mpm_ip equ es:word ptr .058h ; MPM vec save
;u_mpm_cs equ es:word ptr .05Ah
;u_debug_ip equ es:word ptr .05Ch ; RTS,Debug Vector Save
;u_debug_cs equ es:word ptr .05Eh
;u_insys equ es:byte ptr .060h ; # times through user_entry
;u_stat_sav equ es:byte ptr .061h
u_conccb equ es:word ptr .062h
;u_lstccb equ es:word ptr .064h
;u_delim equ es:byte ptr .066h
u_ioexerr equ es:byte ptr .067h ;extended IOS error for PCMODE


77
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/UDA.FMT Normal file
View File

@@ -0,0 +1,77 @@
;*****************************************************
;*
;* User Data Area - The User Data Area is an
;* extension of the process descriptor but it
;* travels with the user. It contains info
;* that is needed only while in context.
;*
;* While in the operating system, The Extra
;* Segment register points to the beginning
;* of the User Data Area.
;*
;*****************************************************
eseg
org 0
u_dparam rw 1 ; arg to dispatch
; this area overlays part of BDOS
u_dma_ofst rw 1 ; BDOS dma offset
u_dma_seg rw 1 ; BDOS dma segment
u_func rb 1 ; actual function number
u_searchl rb 1 ; BDOS search length
u_searcha rw 1 ; BDOS search FCB offset
u_searchabase rw 1 ; BDOS search user's segment
u_dcnt rw 1 ; BDOS directory count
u_dblk rw 1 ; BDOS directory block #
u_error_mode rb 1 ; BDOS error mode
u_mult_cnt rb 1 ; BDOS multi-sector count
u_df_password rb 8 ; BDOS default password
u_pd_cnt rb 1 ; BDOS process count
uda_ovl_len equ (offset $)-(offset u_dma_ofst)
; end of overlay area
u_in_int rb 1
u_sp rw 1 ; save register area
u_ss rw 1
u_ax rw 1
u_bx rw 1
u_cx rw 1
u_dx rw 1
u_di rw 1
u_si rw 1
u_bp rw 1
u_wrkseg rw 1 ; curr seg addr of buf
u_retseg rw 1 ; usr ES return
u_ds_sav rw 1 ;\
u_stack_sp rw 1 ; usr stack segment
u_stack_ss rw 1 ; usr stack pointer
u_ivectors rw 4 ; save int 0,1
u_ivec87_of rw 1 ; NDP interrupt vector
u_ivec87_sg rw 1 ; for exception handling
u_ivectors2 rw 4 ; save int 3,4
u_es_sav rw 1 ; > Used during interrupts
u_flag_sav rw 1 ;/
u_initcs rw 1
u_initds rw 1
u_inites rw 1
u_initss rw 1
u_os_ip rw 1 ; O.S. vec save
u_os_cs rw 1
u_debug_ip rw 1 ; RTS,Debug Vector Save
u_debug_cs rw 1
u_insys rb 1 ; # times through user_entry
u_stat_sav rb 1 ; used during interrupts
u_conccb rw 1 ; default console's CCB addr
u_lstccb rw 1 ; default list devices CCB addr
u_delim rb 1 ; delimiter for user function 9
u_ioexerr rb 1 ; extended error ret codes for bdos
org ulen
u_8087 rw 47 ; 8087 save area
; see dispatcher, loader and terminate


31
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/UTIL.MEM Normal file
View File

@@ -0,0 +1,31 @@
;*****************************************************
;*
;* MEM Common Functions
;*
;*****************************************************
getmd: ; get MD from MDUL
;----- ------------------
; output: BX = MD address
; 0 if none found
; CX = Error Code
pushf ! cli
mov cx,e_no_umd ! mov bx,mdul
cmp bx,0 ! je gmd_ret
xor cx,cx
mov si,m_link[bx] ! mov mdul,si
mov m_link[bx],cx ! mov m_start[bx],cx
mov m_length[bx],cx ! mov m_plist[bx],cx
gmd_ret:popf ! ret
freemd: ; put MD on MDUL
;------ ----------------
; input: BX = MD address
pushf ! cli
mov si,mdul ! mov mdul,bx
mov m_link[bx],si ! popf ! ret


26
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/VEC.FMT Normal file
View File

@@ -0,0 +1,26 @@
;*****************************************************
;*
;* Interrupt Vectors - to fiddle with the interrupt
;* vectors, set the Data Segment Register to 0
;* and use the following variables.
;*
;*****************************************************
DSEG
i_divide_ip rw 1 ; int 0
i_divide_cs rw 1
i_trace_ip rw 1 ; int 1
i_trace_cs rw 1
i_nomask_ip rw 1 ; int 2
i_nomask_cs rw 1
i_break_ip rw 1 ; int 3
i_break_cs rw 1
i_ovrflw_ip rw 1 ; int 4
i_ovrflw_cs rw 1
i_interrupts rw ((osint-5)*2)
i_os_ip rw 1
i_os_cs rw 1
i_debug_ip rw 1
i_debug_cs rw 1


16
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D1/XIOSDAT.FMT Normal file
View File

@@ -0,0 +1,16 @@
;*****************************************************
;*
;* Concurrent CP/M XIOS Data Area
;*
;*****************************************************
DSEG
org 0C0CH
tick rb 1
;see XIOS for format of the rest of the
;XIOS header, most of the variables
;are copied to the System Data Segment
;by GENSYS.


18
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/COMLIT.LIT Normal file
View File

@@ -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';


9
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/COPYRT.LIT Normal file
View File

@@ -0,0 +1,9 @@
/*
Copyright (C) 1983
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/


529
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/DISP.PLM Normal file
View File

@@ -0,0 +1,529 @@
$title ('SDIR - Display Files')
display:
do;
/* Display Module for SDIR */
$include(comlit.lit)
$include(mon.plm)
dcl (cur$drv, cur$usr) byte external;
dcl (os,bdos) byte external;
$include(vers.lit)
dcl used$de address external; /* number of used directory entries */
dcl date$opt boolean external; /* date option flag */
dcl display$attributes boolean external; /* attributes display flag */
dcl sorted boolean external;
dcl filesfound address external;
$include (search.lit)
dcl find find$structure external;
dcl format byte external, /* format is one of the following */
page$len address external, /* page size before printing new headers */
message boolean external, /* print titles and msg when no file found */
formfeeds boolean external; /* use form feeds to separate headers */
$include(format.lit)
dcl file$displayed boolean public initial (false);
/* true if we ever display a file, from any drive or user */
/* used by main.plm for file not found message */
dcl dir$label byte external;
$include(fcb.lit)
$include(xfcb.lit)
dcl
buf$fcb$adr address external, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(f$i$adr,last$f$i$adr,first$f$i$adr) address external,
cur$file address; /* number of file currently */
/* being displayed */
$include(finfo.lit)
/* structure of file info */
dcl file$info based f$i$adr f$info$structure;
dcl x$i$adr address external,
xfcb$info based x$i$adr x$info$structure;
dcl f$i$indices$base address external, /* if sorted then f$i$indices */
f$i$indices based f$i$indices$base (1) address; /* are here */
/* -------- Routines in util.plm -------- */
printchar: procedure (char) external;
dcl char byte;
end printchar;
print: procedure (string$adr) external; /* BDOS call # 9 */
dcl string$adr address;
end print;
printb: procedure external;
end printb;
crlf: procedure external;
end crlf;
printfn: procedure(fname$adr) external;
dcl fname$adr address;
end printfn;
pdecimal: procedure(v,prec,zerosup) external;
/* print value val, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean; /* zero suppression flag */
end pdecimal;
p3byte: procedure(byte3adr,prec)external;
/* print 3 byte value with 0 suppression */
dcl (byte3adr,prec) address; /* assume high order bit is < 10 */
end p3byte;
add3byte: procedure (byte3$adr,word$amt) external;
dcl (byte3$adr, word$amt) address;
end add3byte; /* add word to 3 byte structure */
add3byte3: procedure (byte3$adr,byte3) external;
dcl (byte3$adr, byte3) address;
end add3byte3; /* add 3 byte quantity to 3 byte total */
shr3byte: procedure (byte3$adr) external;
dcl byte3$adr address;
end shr3byte;
/* -------- Routines in search.plm -------- */
search$first: procedure(fcb$adr) byte external;
dcl fcb$adr address;
end search$first;
search$next: procedure byte external;
end search$next;
/*break: procedure external;
end break;*/
match: procedure boolean external;
dcl fcb$adr address;
end match;
/* -------- Other external routines -------- */
display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
dcl ts$adr address;
end display$time$stamp;
terminate: procedure external; /* in main.plm */
end terminate;
mult23: procedure(index) address external; /* in sort.plm */
dcl index address;
end mult23;
/* -------- From dpb86.plm or dpb80.plm -------- */
$include(dpb.lit)
dpb$byte: procedure (dpb$index) byte external;
dcl dpb$index byte;
end dpb$byte;
dpb$word: procedure (dpb$index) address external;
dcl dpb$index byte;
end dpb$word;
/* -------- routines and data structures local to this module -------- */
direct$console$io: procedure byte;
return mon2(6,0ffh); /* ff to stay downward compatable */
end direct$console$io;
wait$keypress: procedure;
declare char byte;
char = direct$console$io;
do while char = 0;
char = direct$console$io;
end;
if char = ctrlc then
call terminate;
end wait$keypress;
declare global$line$count byte initial(1);
dcl total$kbytes structure ( /* grand total k bytes of files matched */
lword address,
hbyte byte),
total$recs structure ( /* grand total records of files matched */
lword address,
hbyte byte),
total$1k$blocks structure( /* how many 1k blocks are allocated */
lword address,
hbyte byte);
add$totals: procedure;
call add3byte(.total$kbytes,file$info.kbytes);
call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
call add3byte(.total$1k$blocks,file$info.onekblocks);
end add$totals;
dcl files$per$line byte;
dcl cur$line address;
dcl hdr (*) byte data (' Name Bytes Recs Attributes $');
dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
dcl hdr$pu (*) byte data (' Prot Update $');
dcl hdr$xfcb$bars (*) byte data (' ------ -------------- --------------$');
dcl hdr$access (*) byte data (' Access $');
dcl hdr$create (*) byte data (' Create $');
/* example date 04/02/55 00:34 */
display$file$info: procedure;
/* print filename.typ */
call printfn(.file$info.name(0));
call printb;
call pdecimal(file$info.kbytes,10000,true);
call printchar('k'); /* up to 32 Meg - Bytes */
/* or 32,000k */
call printb;
call p3byte(.file$info.recs$lword,1); /* records */
call printb;
if rol(file$info.name(f$dirsys-1),1) then /* Type */
call print(.('Sys$'));
else call print(.('Dir$'));
call printb;
if rol(file$info.name(f$rw-1),1) then
call print(.('RO$'));
else call print(.('RW$'));
call printb;
if not display$attributes then do;
if rol(file$info.name(f$arc-1),1) then
call print(.('Arcv $'));
else
call print(.(' $'));
end;
else do;
if rol(file$info.name(f$arc-1),1) then /* arc bit was on in all */
call print$char('A'); /* dir entries */
else call printb;
if rol(file$info.name(0),1) then
call print$char('1');
else call printb;
if rol(file$info.name(1),1) then
call print$char('2');
else call printb;
if rol(file$info.name(2),1) then
call print$char('3');
else call printb;
if rol(file$info.name(3),1) then
call print$char('4');
else call printb;
end;
end display$file$info;
display$xfcb$info: procedure;
if file$info.x$i$adr <> 0 then
do;
call printb;
x$i$adr = file$info.x$i$adr;
if (xfcb$info.passmode and pm$read) <> 0 then
call print(.('Read $'));
else if (xfcb$info.passmode and pm$write) <> 0 then
call print(.('Write $'));
else if (xfcb$info.passmode and pm$delete) <> 0 then
call print(.('Delete$'));
else
call print(.('None $'));
call printb;
if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
call display$timestamp(.xfcb$info.update);
else call print(.(' $'));
call printb; call printb;
if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
call display$timestamp(.xfcb$info.create(0));
/* Create/Access */
end;
end display$xfcb$info;
dcl first$title boolean initial (true);
display$title: procedure;
if formfeeds then
call print$char(ff);
else if not first$title then
call crlf;
call print(.('Directory For Drive $'));
call printchar('A'+ cur$drv); call printchar(':');
if bdos >= bdos20 then
do;
call print(.(' User $'));
call pdecimal(cur$usr,10,true);
end;
call crlf;
cur$line = 2;
first$title = false;
end display$title;
short$display: procedure (fname$adr);
dcl fname$adr address;
if cur$file mod files$per$line = 0 then
do;
if cur$line mod page$len = 0 then
do;
call crlf;
call display$title;
call crlf;
end;
else
call crlf;
cur$line = cur$line + 1;
call printchar(cur$drv + 'A');
end;
else call printb;
call print(.(': $'));
call printfn(fname$adr);
cur$file = cur$file + 1;
end short$display;
test$att: procedure(char,off,on) boolean;
dcl (char,off,on) byte;
if (80h and char) <> 80h and off then
return(true);
if (80h and char) = 80h and on then
return(true);
return(false);
end test$att;
right$attributes: procedure(name$adr) boolean;
dcl name$adr address,
name based name$adr (1) byte;
return
test$att(name(f$rw-1),find.rw,find.ro) and
test$att(name(f$dirsys-1),find.dir,find.sys);
end right$attributes;
short$dir: procedure; /* looks like "DIR" command */
dcl dcnt byte;
fcb(f$drvusr) = '?';
files$per$line = 4;
dcnt = search$first(.fcb);
do while dcnt <> 0ffh;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
if (buf$fcb(f$drvusr) and 0f0h) = 0 and
buf$fcb(f$ex) = 0 and
buf$fcb(f$ex)<= dpb$byte(extmsk$b) then /* no dir labels, xfcbs */
if match then
if right$attributes(.buf$fcb(f$name)) then
call short$display(.buf$fcb(f$name));
dcnt = search$next;
end;
end short$dir;
dcl (last$plus$one,index) address;
getnxt$file$info: procedure; /* set f$i$adr to base file$info on file */
dcl right$usr boolean; /* to be displayed, f$i$adr = 0ffffh if end */
right$usr = false;
if sorted then do;
index = index + 1;
if index < filesfound then do;
f$i$adr = mult23(f$i$indices(index));
do while (file$info.usr <> cur$usr) and (index < filesfound);
index = index + 1;
if index < filesfound then
f$i$adr = mult23(f$i$indices(index));
end;
end;
if index = files$found then
f$i$adr = last$plus$one; /* no more files */
end;
else /* not sorted display in order found in directory */
do; /* use last$plus$one to avoid wrap around problems */
f$i$adr = f$i$adr + size(file$info);
do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
f$i$adr = f$i$adr + size(file$info);
end;
end;
end getnxt$file$info;
size$display: procedure;
if (format and form$size) <> 0 then
files$per$line = 3;
else files$per$line = 4;
do while f$i$adr <> last$plus$one;
if ((file$info.x$i$adr <> 0 and find.xfcb) or
file$info.x$i$adr = 0 and find.nonxfcb) and
right$attributes(.file$info.name(0)) then
do;
call add$totals;
call short$display(.file$info.name(0));
call pdecimal(file$info.kbytes,10000,true);
call print(.('k$'));
end;
call getnxt$file$info;
end;
end size$display;
display$no$dirlabel: procedure;
files$per$line = 2;
do while f$i$adr <> last$plus$one; /* Do all valid files */
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
if cur$file mod files$per$line <> 0 then call printb;
else do; /* need a new line */
if cur$line mod page$len <> 0 then do; /* just crlf */
call crlf;
cur$line = cur$line + 1;
end;
else do; /* print header */
call crlf;
call display$title; call crlf;
call print(.hdr); call printb; call print(.hdr);
call crlf;
call print(.hdr$bars); call printb; call print(.hdr$bars);
call crlf;
cur$line = cur$line + 3;
end;
end;
call display$file$info;
cur$file = cur$file + 1;
call add$totals;
end;
call getnxt$file$info;
end;/* do loop */
end display$no$dirlabel;
display$with$dirlabel: procedure;
files$per$line = 1;
do while f$i$adr <> last$plus$one; /* Display the file info */
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
if cur$line mod page$len = 0 then do; /* display the header */
call crlf;
call display$title; call crlf;
call print(.hdr); call print(.hdr$pu);
if (dirlabel and dl$access) <> 0 then
call print(.hdr$access);
else call print(.hdr$create);
call crlf;
call print(.hdr$bars); call print(.hdr$xfcb$bars);
cur$line = cur$line + 2;
end; /* header display */
call crlf;
call display$file$info; /* display non bdos 3.0 file info */
call display$xfcb$info;
cur$file = cur$file+1; cur$line = cur$line+1;
call add$totals;
end;
call getnxt$file$info;
end;
end display$with$dirlabel;
display$files: procedure public; /* MODULE ENTRY POINT */
/* display the collected data */
cur$line, cur$file = 0; /* force titles and new line */
totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
f$i$adr = first$f$i$adr - size(file$info); /* initial if no sort */
last$plus$one = last$f$i$adr + size(file$info);
index = 0ffffh; /* initial if sorted */
call getnxt$file$info; /* base file info record */
if format > 2 then
do;
call print(.('Illegal Format Value$'));
call terminate; /* default could be patched - watch it */
end;
do case format; /* format = */
call short$dir; /* form$short */
call size$display; /* form$size */
/* form = full */
if date$opt then do;
if ((( dir$label and dl$exists) <> 0 ) and
((( dir$label and dl$access) <> 0 ) or
(( dir$label and dl$update) <> 0 ) or
(( dir$label and dl$makexfcb) <> 0 ))) then
call display$with$dirlabel; /* Timestamping is active! */
else do;
call print(.('Date and Time Stamping Inactive$'));
call terminate;
end;
end;
else do; /* No date option; Regular Full display */
if (dir$label and dl$exists) <> 0 then
call display$with$dirlabel;
else
call display$no$dirlabel;
end;
end; /* end of case */
if format <> form$short and cur$file > 0 then /* print totals */
do;
if cur$line + 4 > page$len and formfeeds then
do;
call printchar(cr);
call printchar(ff); /* need a new page ? */
end;
else
do;
call crlf;
call crlf;
end;
call print(.( 'Total Bytes = $'));
call p3byte(.total$kbytes,1); /* 6 digit max */
call printchar('k');
call print(.(' Total Records = $'));
call p3byte(.total$recs,10); /* 7 digit max */
call print(.(' Files Found = $'));
call pdecimal(cur$file,1000,true); /* 4 digit max */
call print(.(cr,lf,'Total 1k Blocks = $'));
call p3byte(.total$1k$blocks,1); /* 6 digit max */
call print(.(' Used/Max Dir Entries For Drive $'));
call print$char('A' + cur$drv);
call print$char(':'); call printb;
call pdecimal(used$de,1000,true);
call print$char('/');
call pdecimal(dpb$word(dirmax$w) + 1,1000,true);
end;
if cur$file = 0 then
do;
if message then
do; call crlf;
call display$title;
call print(.('File Not Found.',cr,lf,'$'));
end;
end;
else do;
file$displayed = true;
if not formfeeds then
call crlf;
end;
end display$files;
end display;


14
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/DPB.LIT Normal file
View File

@@ -0,0 +1,14 @@
/* indices into disk parameter block, used as parameters to dpb procedure */
dcl spt$w lit '0',
blkshf$b lit '2',
blkmsk$b lit '3',
extmsk$b lit '4',
blkmax$w lit '5',
dirmax$w lit '7',
dirblk$w lit '9',
chksiz lit '11',
offset$w lit '13';


51
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/DPB86.PLM Normal file
View File

@@ -0,0 +1,51 @@
$compact
$title ('SDIR 8086 - Get Disk Parameters')
dpb86:
do;
/* the purpose of this module is to allow independence */
/* of processor, i.e., 8080 or 8086 */
$include (comlit.lit)
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
parameter block for the currently selected disk, which consists of:
spt (2 bytes) number of sectors per track
blkshf (1 byte) block size = shl(double(128),blkshf)
blkmsk (1 byte) sector# and blkmsk = block number
extmsk (1 byte) logical/physical extents
blkmax (2 bytes) max alloc number
dirmax (2 bytes) size of directory-1
dirblk (2 bytes) reservation bits for directory
chksiz (2 bytes) size of checksum vector
offset (2 bytes) offset for operating system
*/
$include(dpb.lit)
declare k$per$block byte public;
declare dpb$base pointer;
declare dpb$array based dpb$base (15) byte;
mon4: procedure (f,a) pointer external;
dcl f byte, a address;
end mon4;
dcl get$dpb lit '31';
dpb$byte: procedure(param) byte public;
dcl param byte;
return(dpb$array(param));
end dpb$byte;
dpb$word: procedure(param) address public;
dcl param byte;
return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
end dpb$word;
base$dpb: procedure public;
dpb$base = mon4(get$dpb,0);
k$per$block = shr(dpb$byte(blkmsk$b)+1 ,3);
end base$dpb;
end dpb86;


361
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/DSKBOOT.A86 Normal file
View File

@@ -0,0 +1,361 @@
title 'Disk Boot for CompuPro DISK1'
;*******************************************************
; Last Modification: 10/14/83
;
; D i s k B O O T
;
; The following code is written onto track 0 sector
; 0 -3 of the disk. This routine is read into memory
; at location 0000:0100h by the CompuPro PROM. This
; routine then loads the system loader into memory.
;
; The format of the CompuPro Floppy Disk Boot sectors
; are as follows:
;
; Trk Sectors Description
; --- ------- -----------
; 0 1 thru 4 Disk Boot program (this routine)
;
; 5 Loader Group Header
; 6 thru 26 Loader Part 1
;
; 1 1 thru ? Loader Part 2 (remainder not on track 0)
; Number of sectors is determined by
; disk density and format.
;
; The following commands are used to generate DSKBOOT.CMD
; as an 8080 model routine
; RASM86 DSKBOOT
; LINK86 DSKBOOT.SYS = DSKBOOT [DATA[ORIGIN[0]]]
;
; The following commands are used to generate the
; boot tracks image in the file BOOTTRKS
; SID86
; #RDSKBOOT.SYS ;strips header and
; #WBOOT,180,37F ;default base page
; PIP BOOTTRKS = BOOT[O],CPMLDR.SYS[O]
;
;*******************************************************
N_TRK equ 26 ;sectors in Track 0
N_BOOT equ 4 ;sectors for Boot
; Assembly Constants
FDPORT equ 0C0H ;base port address for DISK1 Controller
FDC_S equ FDPORT ;8272 status register
FDC_D equ FDPORT+1 ;8272 data register
D1_DMA equ FDPORT+2 ;DISK1 DMA address (when write)
D1_INTS equ FDPORT+2 ;DISK1 status Register (when read)
DELCNT equ 5*1000 ;delay count for 5 MHz processor
RQM_DELAY equ 5 ;12us delay count for master status
; Intel 8272 controller function definitions
; Specify (00) command
F_SPEC equ 03 ;specify
F_DSTS equ 04 ;drive status
F_RDAT equ 06 ;read data
F_RECA equ 07 ;recalibrate
F_RSTS equ 08 ;read status
F_RID equ 0Ah ;read ID
F_SEEK equ 0Fh ;seek
SRT equ 16-8 ;shuggart 800s
HUT equ 240/16 ;head unload = 240 ms
HLT equ (35+1)/2 ;head load = 35 ms
ND equ 00 ;set DMA mode
cgroup group code,data ;force code and data into 8080 model
;-------------------------------------------------------
; Bootstrap load.
; Do not change any addresses from here to START:
; Entry CL= Board switches from CompuPro PROM (0 .. 3)
CSEG
org 0100H ;origin for 8080 model
nop! nop! nop ;these instructions have already
nop! nop! nop ; been prefetched from the
nop ; CompuPro boot PROM
; Start of Boot code.
; Save board option value.
; Load bios.
start:
;=====
cli
mov ax,cs
mov es,ax
mov ss,ax ;switch to local stack in base page
mov sp,offset stack ;area from 0080h down
xor bx,bx! mov ds,bx
mov opts,cl ;save DISK1 board options switch
mov ds,ax ;DS = CS, 8080 model
retry:
mov si,offset spec ;specify controller parameters
mov cl,LSPEC ;length of specify command
call send_command ;send command to 8272
;SI = offset of recal command
mov cl,LRECAL ;length of recal command
call send_command ;Recalibrate drive
end_rcal:
in al,D1_INTS ;interrupts are disabled, so we
or al,al! jns end_rcal ;poll for command completion
mov al,F_RSTS ;send sense interrupt status to 8272
out FDC_D,al ;required after recal command
mov cx,250 ;Leave lite on for 1/4 second
call delay
call wait_rqm ;wait for drive ready
in al,FDC_D ;get status 0 from 8272
sub al,020h ;remove seek end bit
mov cl,al
call wait_rqm ;wait for drive ready
in al,FDC_D ;get present cylinder number
or al,cl! jnz error ;error if not on track 0 after recal
mov ax,ds ;setup AX to segment address of CMD
add ax,offset header_buf/16 ; header buffer in base page for DMA
mov si,offset read_ghdr ;command to read loader group header
call disk_read ;read loader group header
jnz error ;if error
mov word ptr header_buf+1,0 ;setup offset for jump far to loader
mov ax,word ptr header_buf+3 ;AX = segment address of DMA
mov si,offset read ;command to read remainder of track 0
call disk_read ;read remainder of track 0
jz read_c1 ;if no errors
error: ; Disk error handler.
;-----
mov cx,2000 ;wait 2 seconds
call delay ; and start all over again
jmps retry
read_c1:
mov si,offset seek ;seek to cylinder 1
mov cl,LSEEK ;length of seek command
call send_command ;send command to 8272
end_seek:
in al,D1_INTS ;interrupts are disabled, so we
or al,al! jns end_seek ;poll for command completion
mov al,F_RSTS ;send sense interrupt status to 8272
out FDC_D,al ;required after seek command
call wait_rqm ;wait for drive ready
in al,FDC_D ;get status 0 from 8272
sub al,020h ;remove seek end bit
mov cl,al
call wait_rqm ;wait for drive ready
in al,FDC_D ;get present cylinder number
sub al,1 ;should be cylinder 1
or al,cl! jnz error ;if error then delay and try again
;determine density and sector
;size of cylinder 1
mov al,F_RID + 040h ;setup to try double density first
try_fm:
mov si,offset readid ;read id to determine density
mov [si],al ;set read command for desired density
mov cl,LREADID ;length of read id command
call execute ;execute command and read result bytes
mov al,status ;get status 0 of result bytes
or al,al! jz dens_ok
mov al,readid
xor al,040h ;toggle MFM flag
test al,040h! jnz error ;tried FM and MFM then error
jmps try_fm
dens_ok:
mov bl,status+6 ;get N field from result bytes
and bx,3! shl bx,1 ; to determine sector size
mov si,read1[bx] ;SI -> command to read side 0 of cyl 1
mov ax,word ptr header_buf+3
add ax,(128*(26-5))/16 ;AX = DMA segment address for cyl 1
call disk_read ;read cylinder 1
jnz error ;if error delay and try again
jmpf dword ptr header_buf+1 ;the group header has been setup
;to point to loader entry
wait_rqm: ;wait for drive ready
;--------
mov al,RQM_DELAY ;must delay 12us before polling
w_rqm1: ;FDC status to insure valid results
dec al ! jnz w_rqm1
w_rqm2:
in al,FDC_S ;get master status from 8272
or al,al! jns w_rqm2 ;if no master ready bit
ret
send_command: ; Send Function to Drive.
;------------
; Entry: SI -> command bytes
; CL = length of command.
; Exit: SI -> end of command + 1.
call wait_rqm ;wait for drive ready
lodsb ;load command byte
out FDC_D,al ;send to 8272 controller
dec cl! jnz send_command ;if more bytes
ret
disk_read: ; Disk Read.
;---------
; Entry: AX = segment address of DMA
; SI -> Command (9 bytes)
; Exit: SI -> End of Command + 1.
; Z flag set if successful read
push ax ;compute 24 bit DMA address
mov cl,4 ;for DISK1 DMA port
shr ax,cl ;AX = most significant 16 bits
xchg al,ah
out D1_DMA,al ;send highest address byte
xchg al,ah
out D1_DMA,al ;send middle address byte
pop ax
shl ax,cl
out D1_DMA,al ;send low address byte
mov cl,LREAD ;length of read command
execute:
call send_command ;send command to controller
wait_int_1:
in al,D1_INTS ;interrupts are disabled, so we
or al,al! jns wait_int_1 ;poll for command completion
mov di,offset status ;SI -> to buffer to save result bytes
mov cl,7 ;number of bytes to save
get_status:
call wait_rqm ;wait for drive ready
in al,FDC_D ;read result byte
stosb ;save in buffer
dec cl! jnz get_status ;wait until all done
mov ax,word ptr status ;get status 0 and 1
sub ax,8040h ;40h - zeros abnormal termination bit
;80h - zeros end of cylinder status bit
ret
delay: ;Delay process.
;-----
; Entry: CX = delay count (nominal milliseconds).
; Exit: AL modified
mov al,DELCNT/26
dely1:
inc cx! dec cx
dec al! jnz dely1 ;if not one millisecond
dec cx
mov al,ch
or al,cl! jnz delay ;if not requested time
ret
;-------------------------------------------------------
DSEG
opts equ byte ptr .0040h
stack equ word ptr .0080h
header_buf equ byte ptr .0080h
; Disk setup command strings.
spec db F_SPEC
db SRT shl 4 + HUT
db HLT shl 1 + ND
LSPEC equ offset $ - offset spec
recal db F_RECA
db 0
LRECAL equ offset $ - offset recal
; Read Loader Group Header.
read_ghdr db F_RDAT
db 0 ;hds,ds1,ds0
db 0 ;Cylinder
db 0 ;Head
db N_BOOT+1 ;Record (sector) of Group
db 0 ;Number of data bytes in sector
db N_BOOT+1 ;EOT
db 7 ;GPL
db 128 ;DTL
LRGHDR equ offset $ - offset read_ghdr
; Read remainder of track 0, sectors 6-26
read db F_RDAT
db 0 ;hds,ds1,ds0
db 0 ;Cylinder
db 0 ;Head
db N_BOOT+2 ;Record (sector) of BIOS
db 0 ;Number of data bytes in sector
db N_TRK ;Read to end of track
db 7 ;GPL
db 128 ;DTL
LREAD equ offset $ - offset read
; Disk Seek command for controller
seek db F_SEEK
db 0
db 1
LSEEK equ offset $ - offset seek
readid db F_RID + 040h
db 0
LREADID equ offset $ - offset readid
status rb 7 ;buffer for status result bytes
read1 dw read_128
dw read_256
dw read_512
dw read_1024
; Read function for single density (128 bytes/sec)
read_128 db F_RDAT
db 0 ;hds,ds1,ds0
db 1 ;Cylinder
db 0 ;Head
db 1 ;Record (sector) of BIOS
db 0 ;Number of data bytes in sector
db 26 ;Read to end of track
db 007h ;GPL
db 128 ;DTL
; Read function for double density (256 bytes/sec)
read_256 db F_RDAT + 040h
db 0 ;hds,ds1,ds0
db 1 ;Cylinder
db 0 ;Head
db 1 ;Record (sector) of BIOS
db 1 ;Number of data bytes in sector
db 26 ;Read to end of track
db 00Eh ;GPL
db 255 ;DTL
; Read function for double density (512 bytes/sec)
read_512 db F_RDAT + 040h
db 0 ;hds,ds1,ds0
db 1 ;Cylinder
db 0 ;Head
db 1 ;Record (sector) of BIOS
db 2 ;Number of data bytes in sector
db 15 ;Read to end of track
db 01Bh ;GPL
db 255 ;DTL
; Read function for double density (1024 bytes/sec)
read_1024 db F_RDAT + 040h
db 0 ;hds,ds1,ds0
db 1 ;Cylinder
db 0 ;Head
db 1 ;Record (sector) of BIOS
db 3 ;Number of data bytes in sector
db 8 ;Read to end of track
db 035h ;GPL
db 255 ;DTL
END


23
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/FCB.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare
f$drvusr lit '0', /* drive/user byte */
f$name lit '1', /* file name */
f$namelen lit '8', /* file name length */
f$type lit '9', /* file type field */
f$typelen lit '3', /* type length */
f$rw lit '9', /* high bit is R/W attribute */
f$dirsys lit '10', /* high bit is dir/sys attribute */
f$arc lit '11', /* high bit is archive attribute */
f$ex lit '12', /* extent */
f$s1 lit '13', /* module byte */
f$rc lit '15', /* record count */
f$diskmap lit '16', /* file disk map */
diskmaplen lit '16', /* disk map length */
f$drvusr2 lit '16', /* fcb2 */
f$name2 lit '17',
f$type2 lit '25',
f$cr lit '32', /* current record */
f$rrec lit '33', /* random record */
f$rreco lit '35'; /* " " overflow */


16
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/FINFO.LIT Normal file
View File

@@ -0,0 +1,16 @@
/* file info record for SDIR - note if this structure changes in size */
/* the multXX: routine in the sort.plm module must also change */
declare
f$info$structure lit 'structure(
usr byte, name (8) byte, type (3) byte, onekblocks address,
kbytes address, recs$lword address, recs$hbyte byte,
hash$link address, x$i$adr address)';
declare
x$info$structure lit 'structure (
create (4) byte,
update (4) byte,
passmode byte)';


6
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/FORMAT.LIT Normal file
View File

@@ -0,0 +1,6 @@
dcl form$short lit '0', /* format values for SDIR */
form$size lit '1',
form$full lit '2';


822
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/GENLDR.PLM Normal file
View File

@@ -0,0 +1,822 @@
$title('Concurrent CP/M System Loader Generation')
genldr:
do;
/*
Copyright (C) 1983,1984
Digital Research, Inc.
P.O. Box 579
Pacific Grove, CA 93950
*/
/*
Revised:
03 October 83 by Bruce Skidmore
16 February 84 by GLP
*/
declare true literally '0FFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare cr literally '0dh';
declare lf literally '0ah';
declare tab literally '09h';
declare esc literally '1bh';
declare bs literally '08h';
declare bios$data$off literally '0180h';
declare reset label external;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
declare maxb address external;
declare bios$fcb (36) byte public initial (
0,'LBIOS3 ','SYS',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
declare bdos$fcb (36) byte public initial (
0,'LBDOS3 ','SYS',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
declare FCBout (36) byte public initial (
0,'CPMLDR ','SYS',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
/*------------------------------------------------------------------------
External Messages
------------------------------------------------------------------------*/
declare
msg9120(16) byte external,
msg9125 byte external,
msg9135 byte external,
msg9140 byte external,
msg9145 byte external,
msg9155 byte external,
msg9160 byte external,
msg9190 byte external,
msg9195 byte external,
msg9250 byte external,
msg9255 byte external,
msg9485 byte external,
msg9490 byte external,
msg9495 byte external,
msg9500 byte external,
msg9505 byte external;
declare sctbfr (1) structure (
record (128) byte) public at (.memory);
declare fcb$msg (13) byte public initial (' . $');
declare display boolean public;
declare dma address public;
declare osbase address public;
declare buff$base address public;
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;
/*
B D O S P r o c e d u r e & F u n c t i o n C a l l s
*/
system$reset:
procedure public;
call mon1 (0,0);
end system$reset;
write$console:
procedure (char) public;
declare char byte;
if display then
call mon1 (2,char);
end write$console;
print$buf:
procedure (buffer$address) public;
declare buffer$address address;
if display then
call mon1 (9,buffer$address);
end print$buf;
crlf:
procedure public;
call write$console (cr);
call write$console (lf);
end crlf;
error:
procedure(term$code,err$type,err$msg$adr) public;
declare (term$code,err$type) byte;
declare err$msg$adr address;
declare (i,temp) byte;
temp = display;
display = true;
call crlf;
call print$buf (.msg9125);
call print$buf (err$msg$adr);
if err$type = 1 then
call print$buf(.fcb$msg);
if term$code then
call system$reset;
call crlf;
display = temp;
end error;
open$file:
procedure (fcb$address) byte public;
declare fcb$address address;
declare fcb based fcb$address (1) byte;
fcb(12), /* ex = 0 */
fcb(32) = 0; /* cr = 0 */
return mon2 (15,fcb$address);
end open$file;
close$file:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (16,fcb$address);
end close$file;
delete$file:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
read$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (20,fcb$address) <> 0 then
do;
call error(true,1,.msg9135);
end;
end read$record;
write$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (21,fcb$address) <> 0 then
do;
call error(true,1,.msg9140);
end;
end write$record;
create$file:
procedure (fcb$address) public;
declare fcb$address address;
declare fcb based fcb$address (1) byte;
if mon2 (22,fcb$address) = 255 then
do;
call error(true,0,.msg9145);
end;
fcb(32) = 0; /* set cr = 0 */
end create$file;
set$DMA$address:
procedure (DMA$address) public;
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
read$random$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (33,fcb$address) <> 0 then
do;
call error(true,1,.msg9135);
end;
end read$random$record;
write$random$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (34,fcb$address) <> 0 then
do;
call error(true,1,.msg9140);
end;
end write$random$record;
set$random$record:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (36,fcb$address);
end set$random$record;
setbuf:
procedure external;
end setbuf;
/*
D a t a S t r u c t u r e s
*/
declare data$base address public;
declare data$end address public;
declare act$data$end address public;
declare act$buf$end address public;
declare bdos$atts(4) address public;
declare bios$atts(4) address public;
declare (sys$clen,sys$cbase,sys$dlen,sys$dbase) address public;
declare (dblk$last,dblk$next) address public;
declare add$buf$adr address public;
declare add$buf based add$buf$adr structure (
base address,
len address);
declare drvtbl$adr address public;
declare drvtbl based drvtbl$adr (16) address;
declare dph$adr address public;
declare dph based dph$adr structure (
xlt address,
scratch1 address,
scratch2 byte,
mf byte,
scratch3 address,
dpb address,
csv address,
alv address,
dirbcb address,
dtabcb address,
hash address,
init address,
login address,
read address,
write address,
unit byte,
chnnl byte,
fcnt byte);
declare dpb$adr address public;
declare dpb based dpb$adr structure (
spt address,
bsh byte,
blm byte,
exm byte,
dsm address,
drm address,
al0 byte,
al1 byte,
cks address,
off address,
psh byte,
phm byte);
declare header$adr address;
declare header$rec based header$adr structure (
gtype byte,
len address,
base address,
min address,
max address);
declare base$pg$adr address public;
declare base$pg based base$pg$adr structure(
clenw address,
clenb byte,
cbase address,
m80 byte,
dlenw address,
dlenb byte,
dbase address,
res1 byte,
elenw address,
elenb byte,
ebase address,
res2 byte,
slenw address,
slenb byte,
sbase address,
res3 byte);
declare temp$fcb$adr address public;
declare temp$fcb based temp$fcb$adr structure(
drv byte,
name(8) byte,
type(3) byte,
ex byte,
s1 byte,
s2 byte,
rc byte,
dm(16) byte,
cur$rec byte,
rr address,
r2 byte);
/*
L o c a l P r o c e d u r e s
*/
movef:
procedure (count,source$adr,dest$adr) public;
declare count address;
declare (source$adr,dest$adr) address;
if count = 0
then return;
else call move (count,source$adr,dest$adr);
end movef;
upper:
procedure(b) byte public;
declare b byte;
if b < ' ' then return cr; /* all non-graphics */
/* translate alpha to upper case */
if b >= msg9155 and b <= msg9160 then
b = b and 101$1111b; /* upper case */
return b;
end upper;
dsply$hex:
procedure (val) public;
declare val byte;
call write$console (msg9120(shr (val,4)));
call write$console (msg9120(val and 0fh));
end dsply$hex;
dsply$hex$adr:
procedure (val) public;
declare val address;
call dsply$hex (high (val));
call dsply$hex (low (val));
call write$console (msg9195);
end dsply$hex$adr;
get$param:
procedure (val$adr) public;
declare (val$adr) address;
declare word$val based val$adr address;
declare base byte;
declare (char) byte;
declare (lbindx) byte;
lbindx = 0;
word$val = 0;
base = 16;
do while (char := upper(tbuff(lbindx:=lbindx+1))) <> cr;
if char = msg9190 then
do;
base = 10;
end;
else
do;
char = char - '0';
if (base = 16) and (char > 9) then
do;
if char > 16
then char = char - 7;
else char = 255;
end;
if char < base then
do;
word$val = word$val*base + char;
end;
else
do;
call error (true,0,.msg9250);
end;
end;
end;
end get$param;
get$atts:
procedure (fcb$adr,atts$adr);
declare fcb$adr address;
declare atts$adr address;
declare atts based atts$adr (4) address;
declare i byte;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if openfile(fcb$adr) = 0ffh then
call error(true,1,.msg9255);
header$adr = .sctbfr(0);
call set$DMA$address(header$adr);
call read$record(fcb$adr);
do i = 0 to 3;
atts(i) = 0;
end;
do i = 0 to 3;
if (header$rec.gtype <> 0) and (header$rec.gtype < 5) then
atts(header$rec.gtype-1) = header$rec.len;
header$adr = header$adr + 9;
end;
end get$atts;
buf$seg$blk:
procedure(space,fcb$adr) public;
declare space address;
declare fcb$adr address;
declare i byte;
if (dma+space) > (buff$base+1000H) then
do;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
do i = 0 to 30;
call set$DMA$address(buff$base + (128 * i));
call write$record(.FCBout);
end;
call movef(double(128),buff$base+0f80h,buff$base);
dma = dma - 0f80H;
call set$DMA$address(dma);
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
end;
end buf$seg$blk;
read$write$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call buf$seg$blk(double(128),fcb$adr);
call read$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end read$write$seg;
read$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call read$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end read$seg;
write$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call write$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end write$seg;
setup$sysdat:
procedure public;
declare sysdat$adr address;
declare sysdat based sysdat$adr structure(
iosentry$off address,
iosentry$seg address,
iosinit$off address,
iosinit$seg address,
ldrentry$off address,
ldrentry$seg address);
sysdat$adr = data$base; /* Point to SYSTEM Data Area */
/* Setup the pointer to the BIOS entry point */
sysdat.iosentry$off = 3; /* Should be 3 */
sysdat.iosentry$seg = sys$cbase + bdos$atts(0); /* BIOS code segment */
/* Setup the pointer to the BIOS init point */
sysdat.iosinit$off = 0; /* Should be 0 but the Linker adds 5 */
sysdat.iosinit$seg = sys$cbase + bdos$atts(0); /* BIOS code segment */
/* Setup the Loader entry point */
sysdat.ldrentry$off = 6;
sysdat.ldrentry$seg = sys$cbase + bdos$atts(0);
return;
end setup$sysdat;
set$value:
procedure (seg,byteoff,value) public;
declare (seg,value) address;
declare byteoff byte;
declare setword$adr address;
declare setword based setword$adr address;
if temp$fcb.rr <> seg/8 then
do;
temp$fcb.rr = seg/8;
temp$fcb.r2 = 0;
call read$random$record(temp$fcb$adr);
end;
setword$adr = buff$base + ((seg and 7)*16) + byteoff;
setword = value;
call write$random$record(temp$fcb$adr);
end set$value;
fixup$segs:
procedure public;
call set$DMA$address(buff$base);
temp$fcb$adr = .FCBout;
temp$fcb.rr = 0FFFFh;
temp$fcb.r2 = 0FFh;
call set$value(8,6,sys$dbase);
call set$value(bdos$atts(0)+8,9,sys$dbase);
return;
end fixup$segs;
initialization:
procedure public;
declare (first,next,bracket) byte;
first = 1;
next = 1;
bracket = false;
if tbuff(0) <> 0 then
do;
do while(next <= tbuff(0)+1);
if (tbuff(next) = ' ') or (tbuff(next) = tab) or (tbuff(next) = msg9485)
or (tbuff(next) = msg9490) then
do;
if tbuff(next) = msg9485 then
bracket = true;
tbuff(next) = 0;
end;
else
do;
tbuff(first) = tbuff(next);
first = first + 1;
end;
next = next + 1;
end;
tbuff(0) = first - 2;
if bracket = true then
do;
call get$param(.osbase);
end;
end;
else
do;
call error(true,0,.msg9495);
end;
end initialization;
setup$sys$file:
procedure public;
declare i byte;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
call delete$file (.FCBout);
call create$file (.FCBout);
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
dma = .sctbfr(0);
buff$base = dma;
do i = 0 to 127;
sctbfr(0).record(i) = 0;
end;
call set$DMA$address (dma);
call write$record (.FCBout);
end setup$sys$file;
read$write$code:
procedure public;
declare i byte;
declare flush$cnt address;
dma = buff$base;
call read$write$seg(.bdos$fcb,bdos$atts(0));
dblk$last = (7 - ((bdos$atts(0)-1) and 7)) * 16;
dma = dma - dblk$last;
call read$write$seg(.bios$fcb,bios$atts(0));
dblk$last = (7 - ((bios$atts(0)-1) and 7)) * 16;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
dma = dma - dblk$last;
flush$cnt = (dma-buff$base+127)/128 - 1;
dma = buff$base;
call set$DMA$address(dma);
do i = 0 to flush$cnt;
call write$record(.FCBout);
call set$DMA$address(dma:=dma + 128);
end;
call set$random$record(.bdos$fcb);
call set$random$record(.bios$fcb);
call set$random$record(.FCBout);
temp$fcb$adr = .FCBout;
temp$fcb.rr = temp$fcb.rr - 1;
temp$fcb$adr = .bdos$fcb;
temp$fcb.rr = temp$fcb.rr - 1;
temp$fcb$adr = .bios$fcb;
temp$fcb.rr = temp$fcb.rr - 1;
/* the following adjustments are to take care */
/* of BIOS data ORG'ed at BIOS$DATA$OFF. */
temp$fcb.rr = temp$fcb.rr + bios$data$off/128;
bios$atts(0) = bios$atts(0) + bios$data$off/16;
bios$atts(1) = bios$atts(1) - bios$data$off/16;
end read$write$code;
read$data:
procedure public;
dma = buff$base + 128;
call set$DMA$address(dma);
call read$random$record(.FCBout);
call set$DMA$address(buff$base);
call read$random$record(.bdos$fcb);
call read$record(.bdos$fcb);
dblk$next = (7 - ((bdos$atts(0)-1) and 7)) * 16;
dblk$last = (7 - ((sys$clen-1) and 7)) * 16;
call movef(dblk$next,(buff$base+128-dblk$next),(dma+128-dblk$last));
dma = dma + (128 - dblk$last) + dblk$next;
call read$seg(.bdos$fcb,bdos$atts(1) - (dblk$next/16));
dma = dma - (7 - ((bdos$atts(1)-(dblk$next/16)-1) and 7)) * 16;
call set$DMA$address(buff$base);
call read$random$record(.bios$fcb);
call read$record(.bios$fcb);
dblk$next = (7 - ((bios$atts(0) - 1) and 7)) * 16;
dma = dma + bios$data$off - (bdos$atts(1)*16);
call movef(dblk$next,(buff$base+128-dblk$next),dma);
dma = dma + dblk$next;
call read$seg(.bios$fcb,bios$atts(1) - (dblk$next/16));
end read$data;
write$bdos$bios$data:
procedure public;
dma = buff$base;
call write$seg(.FCBout,(bios$data$off/16)+bios$atts(1)+dblk$last/16);
end write$bdos$bios$data;
clean$up:
procedure public;
header$adr = .sctbfr(0);
call set$DMA$address(header$adr);
FCBout(33), FCBout(34), FCBout(35) = 0;
call read$random$record(.FCBout);
header$rec.gtype = 1;
header$rec.len = sys$clen + sys$dlen;
header$rec.base = sys$cbase;
header$rec.min = sys$clen + sys$dlen;
header$adr = header$adr + 9;
header$rec.base = sys$dbase;
call write$random$record(.FCBout);
call close$file(.FCBout);
call close$file(.bios$fcb);
call close$file(.bdos$fcb);
end clean$up;
print$epilog:
procedure public;
display = true;
call print$buf (.msg9500);
end print$epilog;
plm:
procedure public;
/*
G E N C P M M a i n P r o g r a m
*/
call initialization;
call get$atts(.bdos$fcb,.bdos$atts);
call get$atts(.bios$fcb,.bios$atts);
sys$clen = bdos$atts(0) + bios$atts(0);
sys$cbase = osbase;
sys$dlen = bios$atts(1);
sys$dbase = sys$clen + osbase;
call setup$sys$file; /* Take care of creating the */
/* system file. */
call read$write$code; /* Read the system code segments */
/* and concatenate them. */
call read$data; /* Read the system data segments */
/* and concat. them. */
dblk$last = 128 - dblk$last;
dma = buff$base + 128;
buff$base = .sctbfr(0);
call movef(dblk$last+(bios$atts(1)*16)+bios$data$off,dma,buff$base);
data$base = buff$base + dblk$last;
data$end = data$base + (bios$atts(1)*16)+bios$data$off;
drvtbl$adr = data$base + bios$data$off; /* position the DRVTBL array */
if drvtbl(0) = 0 then
call error(true,0,.msg9505);
sys$dbase = sys$clen + osbase;
act$data$end = data$end - data$base;
call setbuf; /* Set up all buffers */
bios$atts(1) = shr((data$end-data$base-bios$data$off+15),4);
sys$dlen = act$buf$end - sys$dbase;
call setup$sysdat; /* Setup the system data. */
call write$bdos$bios$data; /* Write the combined and updated */
/* data to the SYS file. */
call fixup$segs; /* Fixup the segment values */
/* that were not known on the 1st */
/* pass. */
call clean$up; /* Fix up the SYS file header and */
/* close the file. */
call print$epilog;
end plm;
end genldr;
EOF


8
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/GENLDR.SUB Normal file
View File

@@ -0,0 +1,8 @@
rasm86 scd2
rasm86 genmsg
;
udi plm86 genldr.plm optimize(3) xref
udi plm86 ldrbuf.plm optimize(3) xref
;
link86 genldr=scd2,genldr,ldrbuf,genmsg[dat[ori[0],add[400],max[0]]]
;

39
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/GENMSG.A86 Normal file
View File

@@ -0,0 +1,39 @@
DSEG
public msg9120,msg9125,msg9135,msg9140,msg9145,msg9155,msg9160,msg9190
public msg9195,msg9250,msg9255,msg9485,msg9490,msg9495,msg9500,msg9505
;;
msg9120 db '0123456789ABCDEF'
;;
msg9125 db 'ERROR: $',0
;;
msg9135 db 'Reading file: $'
;;
msg9140 db 'Writing file: $'
;;
msg9145 db 'Directory full$',0
;;
msg9155 db 'a',0
;;
msg9160 db 'z',0
;;
msg9190 db '#',0
;;
msg9195 db 'H',0
;;
msg9250 db 'Must be a Hex or Decimal number$'
;;
msg9255 db 'Unable to open file $',0
;;
msg9485 db '[',0
;;
msg9490 db ']',0
;;
msg9495 db 'Loader base must be specified.$',0
;;
msg9500 db 0dh,0ah,'*** CCP/M SYSTEM LOADER GENERATION DONE ***',0dh,0ah,'$',0
db 'DRI$',0
;;
msg9505 db 'Drive Table must contain at least 1 DPH address.$'


1667
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LBDOS3.A86 Normal file
View File

File diff suppressed because it is too large Load Diff

3
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LBDOS3.SUB Normal file
View File

@@ -0,0 +1,3 @@
rasm86 lbdos3.a86
link86 lbdos3.sys=lbdos3[data[ori[0],max[0]]]


1418
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LBIOS.A86 Normal file
View File

File diff suppressed because it is too large Load Diff

200
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LDRBUF.PLM Normal file
View File

@@ -0,0 +1,200 @@
$title ('GENLDR - Buffer allocation module')
setup$buffers:
do;
/*
Copyright (C) 1982,1983,1984
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/
/*
Revised:
03 October 83 by Bruce Skidmore
*/
declare true literally '0FFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare cr literally '0dh';
declare lf literally '0ah';
declare bcbsize literally '10h';
declare bcbhsize literally '4';
/*
D a t a S t r u c t u r e s
*/
declare osbase address external;
declare sys$dbase address external;
declare sys$dlen address external;
declare data$base address external;
declare data$end address external;
declare act$data$end address external;
declare act$buf$end address external; /* paragraph value */
declare drvtbl$adr address external;
declare drvtbl based drvtbl$adr (16) address;
declare dph$adr address external;
declare dph based dph$adr structure (
xlt address,
scratch1 address,
scratch2 byte,
mf byte,
scratch3 address,
dpb address,
csv address,
alv address,
dirbcb address,
dtabcb address,
hash address,
unit byte,
type byte,
init address,
login address,
read address,
write address);
declare dpb$adr address external;
declare dpb based dpb$adr structure (
spt address,
bsh byte,
blm byte,
exm byte,
dsm address,
drm address,
al0 byte,
al1 byte,
cks address,
off address,
psh byte,
phm byte);
declare bcb$end address public;
declare bcb$header based bcb$end structure(
link address,
bufmax byte);
declare bcb$adr address public;
declare bcb based bcb$adr structure (
drv byte,
rec(3) byte,
wflg byte,
zero byte,
track address,
sector address,
bufoff address,
link address,
resv address);
declare act$bcb$end address public;
declare rec$size address public;
/*
L o c a l P r o c e d u r e s
*/
zero$buf:
procedure public;
declare w$index address;
declare mem$ptr address;
declare bcb$buf$byte based mem$ptr byte;
mem$ptr = data$end; /* Zero memory where BCB's will be created */
do w$index = 0 to 255;
bcb$buf$byte = 0;
mem$ptr = mem$ptr + 1;
end;
end zero$buf;
/* Setup Allocation Vectors and Checksum vectors as requested */
setup$alv$csv:
procedure public;
if dph.csv = 0ffffh then /* Setup Checksum vector */
do;
dph.csv = 0;
end;
if dph.alv = 0ffffh then /* Setup Allocation vector */
do;
dph.alv = 0;
end;
end setup$alv$csv;
setup$dirbufs: /* Setup Directory buffers and BCB's */
procedure public;
if dph.dirbcb = 0ffffH then
do;
dph.dirbcb = act$bcb$end; /* Point dph to bcb header */
act$bcb$end = act$bcb$end + bcbhsize;/* increment past bcb header */
bcb$header.link = act$bcb$end;
bcb$header.bufmax = 0ffh;
bcb$end = bcb$end + bcbhsize;
bcb$adr = bcb$end;
bcb$end = bcb$end + bcbsize;
act$bcb$end = act$bcb$end + bcbsize;
bcb.drv = 0ffh;
bcb.bufoff = act$data$end;
bcb.link = 0;
act$data$end = act$data$end + rec$size;
end;
end setup$dirbufs;
setup$databufs: /* Setup Data buffers and BCB's */
procedure public;
if dph.dtabcb = 0ffffH then
do;
dph.dtabcb = act$bcb$end; /* Point dph to bcb header */
act$bcb$end = act$bcb$end + bcbhsize;/* increment past bcb header */
bcb$header.link = act$bcb$end;
bcb$header.bufmax = 0ffh;
bcb$end = bcb$end + bcbhsize;
bcb$adr = bcb$end;
bcb$end = bcb$end + bcbsize;
act$bcb$end = act$bcb$end + bcbsize;
bcb.drv = 0ffh;
bcb.bufoff = act$buf$end;
bcb.link = 0;
act$buf$end = act$buf$end + rec$size/16;
end;
end setup$databufs;
setbuf:
procedure public;
act$data$end = (act$data$end+1) and 0FFFEH;/* make even */
if drvtbl(0) = 0 then /* one entry required */
return;
call zero$buf;
dph$adr = drvtbl(0) + data$base;
dpb$adr = dph.dpb + data$base;
rec$size = shl(double(128),dpb.psh);
bcb$end = data$end; /* Maintain a ptr. to the current end of BCB's */
act$bcb$end = act$data$end;/* BCB table base in gen'ed system */
act$data$end = act$bcb$end + (bcbhsize+bcbsize)*2;
call setup$alv$csv; /* Setup Allocation and Checksum Vectors */
call setup$dirbufs; /* Setup Directory buffers and BCB's */
act$buf$end = sys$dbase + shr(act$data$end+15,4);
call setup$databufs; /* Setup Data buffers and BCB's */
data$end = bcb$end;
if dph.hash = 0ffffh then
dph.hash = 0; /* Indicate no hash table for this drive */
end setbuf;
end setup$buffers;
EOF


109
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LOADER.HLP Normal file
View File

@@ -0,0 +1,109 @@
BOOT TRACKS CONSTRUCTION FOR THE COMPUPRO
The loader, which resides on the system tracks, is created with
the following sequence of commands:
;; The following sequence of commands may be executed from
;; a SUBMIT file.
;
RASM86 DSKBOOT
;
LINK86 DSKBOOT.SYS=DSKBOOT[DATA[ORIGIN[0]]]
;
RASM86 LBIOS
;
RASM86 LPROG
;
LINK86 LBIOS3.SYS=LBIOS,LPROG[DATA[ORIGIN[180]]]
;
;; GENLDR will create the CPMLDR.SYS
;
GENLDR [NNNN]
;
;; NNNN:0000 is where cpmldr will be loaded at boot time, so be careful that
;; CCPM.SYS will not be loaded over your cpmldr.
;;
;; End of the SUBMIT file
Now read in the file DSKBOOT.SYS with DDT86 (this can't be done under
SUBMIT) and remove the header and base page. This will allow you to
merge this into the CPMLDR file.
A>DDT86
-RDSKBOOT.SYS
START END
aaaa:0000 aaaa:37f
-WBOOT,180,37F
-^C
Now merge the two files with the following command line:
A>PIP BOOTTRKS=BOOT[O],CPMLDR.SYS[O]
Assemble and link the track copy utility with the following commands:
A>RASM86 TCOPY
A>LINK86 TCOPY
The final step is to execute TCOPY under a version of CP/M-86 1.X.
****************************************************************
**** | Because TCOPY does direct BIOS calls, it will not | ****
**** | execute under any other operating system. | ****
****************************************************************
A>TCOPY BOOTTRKS
You should now have a system loader on the boot tracks that will
load a file called CCPM.SYS into memory and begin system ececution.


251
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/LPROG.A86 Normal file
View File

@@ -0,0 +1,251 @@
title 'Concurrent CP/M Loader Program'
;*******************************************************
;
; The Loader Program opens the file 'CCPM.SYS'
; using the LBDOS and LBIOS and then reads it into
; memory. The DS register is set to the start of
; the Concurrent CP/M DATA area, and a JMPF to the first
; byte of the Concurrent CP/M code is executed.
;
; The first 128 byte record of the CCPM.SYS file is
; a header with the following format:
;
; +----+----+----+----+----+----+----+----+----+
; |TYPE| LEN | ABS | MIN | MAX |
; +----+----+----+----+----+----+----+----+----+
;
; type rb 1 ;seg type
; len rw 1 ;length
; abs dw 1 ;absolute segment address for LOADER
; min rw 1 ;minimum mem
; max rw 1 ;max mem needed
;
; The code is expected first and then the data
; within the CCPM.SYS File. This header record
; is constructed automatically by the system
; generation utility GENCCPM. See the variables
; declared at 'SEC1:' where the first sector of
; the CCPM.SYS will be read.
;
; The following commands are used to generate CPMLDR.SYS
; RASM86 LBIOS
; RASM86 LPROG
; LINK86 LBIOS3.SYS = LBIOS,LPROG [DATA[ORIGIN[0180]]]
; GENLDR [nnnn]
;
; The following commands are used to generate the
; boot tracks image BOOTTRKS
; SID86
; #RDSKBOOT.SYS ;strips header and
; #WBOOT,180,37F ;default base page
; PIP BOOTTRKS = BOOT[O],CPMLDR.SYS[O]
;
;*******************************************************
CR equ 13
LF equ 10
CTYPE equ byte ptr 00h
CLEN equ word ptr 01h
CLDSEG equ word ptr 03h
DTYPE equ byte ptr 09h
DLEN equ word ptr 0Ah
DLDSEG equ word ptr 0Ch
CODETYPE equ 1 ;code type CMD header
DATATYPE equ 2 ;data type CMD header
; bdos function numbers
DRV_SET equ 14
F_OPEN equ 15
F_READ equ 20
F_DMASET equ 26
F_USERNUM equ 32
F_MULTISEC equ 44
F_DMA equ 51
;*******************************************************
;
; LOADER starts here
;
;*******************************************************
CSEG
org 0000h
public ?start
extrn ?conout:near, ?pmsg:near
?start: ; loader entry from BDOS init
;------
mov si,offset signon ;print signon message
call ?pmsg
mov dl,0
mov cl,DRV_SET ! int 224 ;select boot drive
mov dl,0
mov cl,F_USERNUM ! int 224 ;set user number
mov dx,offset ccpm_fcb
mov cl,F_OPEN ! int 224 ;open CCPM.SYS file
cmp al,255 ! jne perr ;insure no error on open
mov si,offset nofile
error:
call ?pmsg ;print no SYSTEM file message
halt:
sti
hlt ;then halt the machine
jmps halt
perr:
mov dx,offset sec1
mov cl,F_DMASET ! int 224 ;set DMA offset address
mov dl,1 ;set Multi-sector count to 1
mov si,ds ;SI = DMA segment address
call read_rec ;read first record
mov bx,offset sec1
cmp CTYPE[bx],CODETYPE ;code type must = 1
je chk_data
badhdr:
mov si,offset hdrerr
jmp error
chk_data:
cmp DTYPE[bx],DATATYPE ;data type must = 2
jne badhdr
mov ax,CLDSEG[bx] ;code abs + code length
add ax,CLEN[bx] ;should be = to data abs
cmp ax,DLDSEG[bx] ! jne badhdr
add ax,DLEN[bx]
cmp ax,CLDSEG[bx] ;check for wrap around
jbe badhdr
mov ccpm_init,0000h ;set O.S. entry offset to 0000h
mov ax,CLDSEG[bx]
mov ccpm_init+2,ax ;set O.S. entry segment
hdrok:
mov si,offset csegmsg ;print out starting code and data
call ?pmsg ; on console
mov ax,word ptr sec1+CLDSEG
call phex ;print base code segment
mov si,offset dsegmsg
call ?pmsg ;print base data segment
mov ax,word ptr sec1+DLDSEG
call phex
mov dx,0
mov cl,F_DMASET ! int 224 ;set DMA offset to 0
;set multi_sector count to 127
mov dl,127 ;to align reads with physical sectors
mov si,word ptr sec1+CLDSEG ;initial DMA segment
call read_rec ;read next 127 sectors
jz done ;Z flag set -> EOF
add si,8*127 ;increment dma segment
mov dl,128 ;set multi-sector count to 128
call read_rec ;read next 128 sectors
jz done ;Z flag set -> EOF
readit1:
add si,8*128 ;increment dma segment
call read_data ;read next 128 sectors
jnz readit1 ;Z flag set -> EOF
done:
mov si,offset crlf ;print carriage return, line feed
call ?pmsg
mov ds,word ptr sec1+DLDSEG ;CCP/M data segment
jmpf cs:dword ptr ccpm_init ;leap to CCP/M initialization
;-------------------------------------------------------
; subroutines
;-------------------------------------------------------
read_rec:
;--------
; Entry: DL = multisector count
; SI = dma segment
mov cl,F_MULTISEC ! int 224 ;set multi-sector count to 128
read_data:
;---------
; Entry: SI = dma segment
; Exit: Z flag set if EOF
; Z flag reset if no error
mov dx,si
mov cl,F_DMA ! int 224 ;set DMA segment for disk IO
mov dx,offset ccpm_fcb
mov cl,F_READ ! int 224 ;next 128 sector read
cmp al,1! jnbe read_error
ret
read_error:
mov si,offset rerr ;print READ ERROR message
jmp error
phex: ;print 4 hex characters from ax
;----
; Entry: AX = hex value to print
mov cx,0404h ;4 in both CH and CL
lhex:
rol ax,cl ;rotate left 4
push cx ! push ax ;save crucial registers
call pnib ;print hex nibble
pop ax ! pop cx ;restore registers
dec ch ! jnz lhex ;and loop four times
ret
pnib: ;print low nibble in AL as hex char
;----
; Entry: AL = hex character to print
and al,0fh
cmp al,9 ! ja p10 ;above 9 ?
add al,'0' ;digit
jmps prn
p10:
add al,'A'-10 ;hex digit A-F
prn:
mov dl,al
putchar:
;-------
; Entry: DL = character to send to console
mov cl,dl
jmp ?conout
; code segment variable
ccpm_init rw 2 ;double word entry to Concurrent CP/M
;*******************************************************
;
; DATA AREA
;
;*******************************************************
DSEG
signon db 'Concurrent CP/M System Loader V1.0 (02/16/84)',0
nofile db CR,LF,'CCPM.SYS Not Found On Boot Disk',0
rerr db CR,LF,'Error Reading CCPM.SYS',0
hdrerr db CR,LF,'Bad Header Record in CCPM.SYS',0
csegmsg db CR,LF,'Code Paragraph Address = ',0
dsegmsg db CR,LF,'Data Paragraph Address = ',0
crlf db CR,LF,0
ccpm_fcb db 0,'CCPM ','SYS',0,0,0,0
db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
db 0
;-------------------------------------------------------
sec1 rb 128 ;read first sector of CCPM.SYS
;here (header record)
;*******************************************************
END


602
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/MAIN.PLM Normal file
View File

@@ -0,0 +1,602 @@
/* C P / M - M P / M D I R E C T O R Y C O M M O N (SDIR) */
/* B E G I N N I N G O F C O M M O N M A I N M O D U L E */
/* This module is included in main80.plm or main86.plm. */
/* The differences between 8080 and 8086 versions are */
/* contained in the modules main80.plm, main86.plm and */
/* dpb80.plm, dpb86.plm and the submit files showing */
/* the different link and location addresses. */
/* REVISION history:
/* Nov 82 Bill Fitler: convert from CP/M Plus to Concurrent CP/M-86 */
/* Feb 83 F.Borda: Took out paging and breaking to allow type-ahead. */
$include (comlit.lit)
$include (mon.plm)
/* Scanner Entry Points in scan.plm */
scan: procedure(pcb$adr) external;
declare pcb$adr address;
end scan;
scan$init: procedure(pcb$adr) external;
declare pcb$adr address;
end scan$init;
/* -------- Routines in other modules -------- */
search$init: procedure external; /* initialization of search.plm */
end search$init;
get$files: procedure external; /* entry to search.plm */
end get$files;
sort: procedure external; /* entry to sort.plm */
end sort;
mult23: procedure (num) address external; /* in sort.plm */
dcl num address;
end mult23;
display$files: procedure external; /* entry to disp.plm */
end display$files;
/* -------- Routines in util.plm -------- */
printb: procedure external;
end printb;
print$char: procedure(c) external;
dcl c byte;
end print$char;
print: procedure(string$adr) external;
dcl string$adr address;
end print;
crlf: procedure external;
end crlf;
p$decimal: procedure(value,fieldsize,zsup) external;
dcl value address,
fieldsize address,
zsup boolean;
end p$decimal;
/* ------------------------------------- */
dcl debug boolean public initial (false);
/* -------- version information -------- */
dcl plmstart label public;
dcl (os,bdos) byte public;
$include (vers.lit)
$include (fcb.lit)
$include(search.lit)
dcl find find$structure public initial
(false,false,false,false, false,false,false,false);
dcl
num$search$files byte public initial(0),
no$page$mode byte public initial(0),
search (max$search$files) search$structure public;
dcl first$f$i$adr address external;
dcl get$all$dir$entries boolean public;
dcl first$pass boolean public;
dcl usr$vector address public initial(0), /* bits for user #s to scan */
active$usr$vector address public, /* active users on curdrv */
drv$vector address initial (0); /* bits for drives to scan */
$include (format.lit)
dcl format byte public initial (form$full),
page$len address public initial (0ffffh),
/* lines on a page before printing new headers, 0 forces initial hdrs */
message boolean public initial(false),/* show titles when no files found*/
formfeeds boolean public initial(false),/* use form feeds */
date$opt boolean public initial(false), /* dates display */
display$attributes boolean public initial(false); /* attributes display */
dcl file$displayed boolean external;
/* true if 1 or more files displayed by dsh.plm */
dcl sort$op boolean initial (true); /* default is to do sorting */
dcl sorted boolean external; /* if successful sort */
dcl cur$usr byte public, /* current user being searched */
cur$drv byte public; /* current drive " " */
/* -------- BDOS calls --------- */
get$version: procedure address; /* returns current version information */
return mon3(12,0);
end get$version;
select$drive: procedure(d);
declare d byte;
call mon1(14,d);
end select$drive;
search$first: procedure(d) byte external;
dcl d address;
end search$first;
search$next: procedure byte external;
end search$next;
get$cur$drv: procedure byte; /* return current drive number */
return mon2(25,0);
end get$cur$drv;
getlogin: procedure address; /* get the login vector */
return mon3(24,0);
end getlogin;
getusr: procedure byte; /* return current user number */
return mon2(32,0ffh);
end getusr;
/**************************************************** commented out whf
getscbbyte: procedure (offset) byte;
declare offset byte;
declare scbpb structure
(offset byte,
set byte,
value address);
scbpb.offset = offset;
scbpb.set = 0;
return mon2(49,.scbpb);
end getscbbyte;
******************************************************/
set$console$mode: procedure;
/* set console mode to control-c only */
/********* call mon1(109,1); ********whf************/
;
end set$console$mode;
terminate: procedure public;
call mon1 (0,0);
end terminate;
/* -------- Utility routines -------- */
number: procedure (char) boolean;
dcl char byte;
return(char >= '0' and char <= '9');
end number;
make$numeric: procedure(char$adr,len,val$adr) boolean;
dcl (char$adr, val$adr, place) address,
chars based char$adr (1) byte,
value based val$adr address,
(i,len) byte;
value = 0;
place = 1;
do i = 1 to len;
if not number(chars(len - i)) then
return(false);
value = value + (chars(len - i) - '0') * place;
place = place * 10;
end;
return(true);
end make$numeric;
set$vec: procedure(v$adr,num) public;
dcl v$adr address, /* set bit number given by num */
vector based v$adr address, /* 0 <= num <= 15 */
num byte;
if num = 0 then
vector = vector or 1;
else
vector = vector or shl(double(1),num);
end set$vec;
bit$loc: procedure(vector) byte;
/* return location of right most on bit vector */
dcl vector address, /* 0 - 15 */
i byte;
i = 0;
do while i < 16 and (vector and double(1)) = 0;
vector = shr(vector,1);
i = i + 1;
end;
return(i);
end bit$loc;
get$nxt: procedure(vector$adr) byte;
dcl i byte,
(vector$adr,mask) address,
vector based vector$adr address;
/* if debug then
do; call print(.(cr,lf,'getnxt: vector = $'));
call pdecimal(vector,10000,false);
end; */
if (i := bit$loc(vector)) > 15 then
return(0ffh);
mask = 1;
if i > 0 then
mask = shl(mask,i);
vector = vector xor mask; /* turn off bit */
/* if debug then
do; call print(.(cr,lf,'getnxt: vector, i, mask $'));
call pdecimal(vector,10000,false);
call printb;
call pdecimal(i,10000,false);
call printb;
call pdecimal(mask,10000,false);
end; */
return(i);
end get$nxt; /* too bad plm rotates only work on byte values */
/* help: procedure; COMMENTED OUT - HELP PROGRAM REPLACE DISPLAY
call print(.(cr,lf,
tab,tab,tab,'DIR EXAMPLES',cr,lf,lf,
'dir file.one',tab,tab,tab,
'(find a file on current user and default drive)',cr,lf,
'dir *.com d:*.pli',tab,tab,'(find matching files on default and d: drive)',
cr,lf,
'dir [rw]',tab,tab,tab,'(find files that are read/write)',cr,lf,
'dir [ro dir sys]',tab,tab,'(same for read/only, directory, system)',cr,lf,
'dir [xfcb]',tab,tab,tab,'(find files with XFCB''s)',cr,lf,
'dir [nonxfcb]',tab,tab,tab,'(find files without XFCB''s)',cr,lf,
'dir [exclude] *.com',tab,tab,'(find files that don''t end in ''com'')',cr,lf,
'dir [nosort]',tab,tab,tab,'(don''t sort the files)',cr,lf,
'dir [full]',tab,tab,tab,'(show all file information)',cr,lf,
'dir [size]',tab,tab,tab,'(show name and size in kilobytes)',cr,lf,
'dir [short]',tab,tab,tab,'(show just the file names)',cr,lf,
'dir [drive = all]',tab,tab,'(search all logged in drives)',cr,lf,
'dir [drive = (a,b,p)]',tab,tab,
'(search specified drives, ''disk'' is synonym)',cr,lf,
'dir [user = all]',tab,tab,'(find files with any user number)',cr,lf,
'dir [user = (0,1,15), G12]',tab,'(find files with specified user number)',
cr,lf,
'dir [length = n]',tab,tab,'(print headers every n lines)',cr,lf,
'dir [ff]',tab,tab,tab,'(print form feeds between headers)',cr,lf,
'dir [message user=all]',tab,tab,'(show user/drive areas with no files)',
cr,lf,
'dir [help]',tab,tab,tab,'(show this message)',cr,lf,
'dir [dir sys rw ro sort xfcb nonxfcb full] d:*.*',tab,'(defaults)$'));
call terminate;
end help; */
/* -------- Scanner Info -------- */
$include (scan.lit)
dcl pcb pcb$structure
initial (0,.buff(0),.fcb,0,0,0,0) ;
dcl token based pcb.token$adr (12) byte;
dcl got$options boolean;
get$options: procedure;
dcl temp byte;
do while pcb.scan$adr <> 0ffffh and ((pcb.tok$typ and t$op) <> 0);
if pcb.nxt$token <> t$mod then
do; /* options with no modifiers */
if token(1) = 'A' then
display$attributes = true;
else if token(1) = 'D' and token(2) = 'I' then
find.dir = true;
else if token(1) = 'D' and token(2) = 'A' then do;
format = form$full;
date$opt = true;
end;
/* else if token(1) = 'D' and token(2) = 'E' then
debug = true; */
else if token(1) = 'E' then
find.exclude = true;
else if token(1) = 'F'then
if token(2) = 'F' then
formfeeds = true;
else if token(2) = 'U' then
format = form$full;
else goto op$err;
else if token(1) = 'G' then
do;
if pcb.token$len < 3 then
temp = token(2) - '0';
else
temp = (token(2) - '0') * 10 + (token(3) - '0');
if temp >= 0 and temp <= 15 then
call set$vec(.usr$vector,temp);
else goto op$err;
end;
/* else if token(1) = 'H' then
call help; */
else if token(1) = 'M' then
message = true;
else if token(1) = 'N' then
if token(4) = 'X' then
find.nonxfcb = true;
else if token(3) = 'P' then
no$page$mode = 0FFh;
else if token(3) = 'S' then
sort$op = false;
else goto op$err;
/* else if token(1) = 'P' then
find.pass = true; */
else if token(1) = 'R' and token(2) = 'O' then
find.ro = true;
else if token(1) = 'R' and token(2) = 'W' then
find.rw = true;
else if token(1) = 'S' then
if token(2) = 'Y' then
find.sys = true;
else if token(2) = 'I' then
format = form$size;
else if token(2) = 'O' then
sort$op = true;
else goto op$err;
else if token(1) = 'X' then
find.xfcb = true;
else goto op$err;
call scan(.pcb);
end;
else
do; /* options with modifiers */
if token(1) = 'L' then
do;
call scan(.pcb);
if (pcb.tok$typ and t$numeric) <> 0 then
if make$numeric(.token(1),pcb.token$len,.page$len) then
if page$len < 5 then
goto op$err;
else call scan(.pcb);
else goto op$err;
else goto op$err;
end;
else if token(1) = 'U' then
do;
/* if debug then
call print(.(cr,lf,'In User option$')); */
call scan(.pcb);
if ((pcb.tok$typ and t$mod) = 0) or bdos < bdos20 then
goto op$err;
do while (pcb.tok$typ and t$mod) <> 0 and
pcb.scan$adr <> 0ffffh;
if token(1) = 'A' and token(2) = 'L' then
usr$vector = 0ffffh;
else if (pcb.tok$typ and t$numeric) <> 0 and pcb.token$len < 3 then
do;
if pcb.token$len = 1 then
temp = token(1) - '0';
else
temp = (token(1) - '0') * 10 + (token(2) - '0');
if temp >= 0 and temp <= 15 then
call set$vec(.usr$vector,temp);
else goto op$err;
end;
else goto op$err;
call scan(.pcb);
end;
end;
else if token(1) = 'D' and (token(2) = 'R' or token(2) = 'I') then
do; /* allow DRIVE or DISK */
call scan(.pcb);
if (pcb.tok$typ and t$mod) = 0 then
goto op$err;
do while (pcb.tok$typ and t$mod ) <> 0 and
pcb.scan$adr <> 0ffffh;
if token(1) = 'A' and token(2) = 'L' then
do;
drv$vector = 0ffffh;
drv$vector = drv$vector and get$login;
end;
else if token(1) >= 'A' and token(1) <= 'P' then
call set$vec(.drv$vector,token(1) - 'A');
else goto op$err;
call scan(.pcb);
end;
end; /* drive option */
else goto op$err;
end; /* options with modifiers */
end; /* do while */
got$options = true;
return;
op$err:
call print(.('ERROR: Illegal Option or Modifier.',
cr,lf,'$'));
call terminate;
end get$options;
get$file$spec: procedure;
dcl i byte;
if num$search$files < max$search$files then
do;
call move(f$namelen + f$typelen,.token(1),
.search(num$search$files).name(0));
if search(num$search$files).name(f$name - 1) = ' ' and
search(num$search$files).name(f$type - 1) = ' ' then
search(num$search$files).anyfile = true; /* match on any file */
else search(num$search$files).anyfile = false;/* speedier compare */
if token(0) = 0 then
search(num$search$files).drv = 0ffh; /* no drive letter with */
else /* file spec */
search(num$search$files).drv = token(0) - 1;
/* 0ffh in drv field indicates to look on all drives that will be */
/* scanned as set by the "drive =" option, see "match:" proc in */
/* search.plm module */
num$search$files = num$search$files + 1;
end;
else
do; call print(.('File Spec Limit is $'));
call p$decimal(max$search$files,100,true);
call crlf;
end;
call scan(.pcb);
end get$file$spec;
set$defaults: procedure;
/* set defaults if not explicitly set by user */
if not (find.dir or find.sys) then
find.dir, find.sys = true;
if not(find.ro or find.rw) then
find.rw, find.ro = true;
if find.xfcb or find.nonxfcb then
do; if format = form$short then
format = form$full;
end;
else /* both xfcb and nonxfcb are off */
find.nonxfcb, find.xfcb = true;
if num$search$files = 0 then
do;
search(num$search$files).anyfile = true;
search(num$search$files).drv = 0ffh;
num$search$files = 1;
end;
if drv$vector = 0 then
do i = 0 to num$search$files - 1;
if search(i).drv = 0ffh then search(i).drv = cur$drv;
call set$vec(.drv$vector,search(i).drv);
end;
else /* a "[drive =" option was found */
do i = 0 to num$search$files - 1;
if search(i).drv <> 0ffh and search(i).drv <> cur$drv then
do; call print(.('ERROR: Illegal Global/Local ',
'Drive Spec Mixing.',cr,lf,'$'));
call terminate;
end;
end;
if usr$vector = 0 then
call set$vec(.usr$vector,get$usr);
/* set up default page size for display */
/**** page$len = 23; /* number lines per screen page */
end set$defaults;
dcl (save$uvec,temp) address;
dcl i byte;
declare last$dseg$byte byte
initial (0);
plmstart:
do;
os = high(get$version);
bdos = low(get$version);
if bdos < bdos22 /* or os <> ccpm86 */
then do;
/*call print(.('Requires Concurrent CP/M-86',cr,lf,'$'));*/
call print(.('Requires BDOS 2.2 or greater.',cr,lf,'$'));
call terminate; /* check to make sure function call is valid */
end;
else
call set$console$mode;
/* note - initialized declarations set defaults */
cur$drv = get$cur$drv;
call scan$init(.pcb);
call scan(.pcb);
no$page$mode = false; /******** getscbbyte(nopage$mode$offset); ***whf***/
got$options = false;
do while pcb.scan$adr <> 0ffffh;
if (pcb.tok$typ and t$op) <> 0 then
if got$options = false then
call get$options;
else
do;
call print(.('ERROR: Options not grouped together.',
cr,lf,'$'));
call terminate;
end;
else if (pcb.tok$typ and t$filespec) <> 0 then
call get$file$spec;
else
do;
call print(.('ERROR: Illegal command tail.',cr,lf,'$'));
call terminate;
end;
end;
call set$defaults;
/* main control loop */
call search$init; /* set up memory pointers for subsequent storage */
do while (cur$drv := get$nxt(.drv$vector)) <> 0ffh;
call select$drive(cur$drv);
save$uvec = usr$vector; /* user numbers to search on each drive */
active$usr$vector = 0; /* users active on cur$drv */
cur$usr = get$nxt(.usr$vector); /* get first user num and mask */
get$all$dir$entries = false; /* off it off */
if usr$vector <> 0 and format <> form$short then
/* find high water mark if */
do; /* more than one user requested */
fcb(f$drvusr) = '?';
i = search$first(.fcb); /* get first directory entry */
temp = 0;
do while i <> 255;
temp = temp + 1;
i = search$next;
end; /* is there enough space in the */
/* worst case ? */
if maxb > mult23(temp) + shl(temp,1) then
get$all$dir$entries = true; /* location of last possible */
end; /* file info record and add */
first$pass = true; /* room for sort indices */
active$usr$vector = 0ffffh;
do while cur$usr <> 0ffh;
/* if debug then
call print(.(cr,lf,'in user loop $')); */
call set$vec(.temp,cur$usr);
if (temp and active$usr$vector) <> 0 then
do;
if format <> form$short and
(first$pass or not get$all$dir$entries) then
do;
call getfiles; /* collect files in memory and */
first$pass = false; /* build the active usr vector */
sorted = false; /* sort module will set sorted */
if sort$op then /* to true, if successful sort */
call sort;
end;
call display$files;
end;
cur$usr = get$nxt(.usr$vector);
end;
usr$vector = save$uvec; /* restore user vector for nxt */
end; /* do while drv$usr drive scan */
if not file$displayed and not message then
call print(.(cr,lf,cr,lf,'No File',cr,lf,'$'));
call terminate;
end;
end sdir;


36
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/MAIN86.PLM Normal file
View File

@@ -0,0 +1,36 @@
$title ('SDIR 8086 - Main Module')
sdir:
do;
$include (copyrt.lit)
/* commands used to generate */
/*
asm86 scd.a86
plm86 main86.plm debug object(main86) optimize(3) 'p2' 'p3' 'p4'
plm86 scan.plm debug object(scan) optimize(3) 'p2' 'p3' 'p4'
plm86 search.plm debug object(search) optimize(3) 'p2' 'p3' 'p4'
plm86 sort.plm debug object(sort) optimize(3) 'p2' 'p3' 'p4'
plm86 disp.plm debug object(disp) optimize(3) 'p2' 'p3' 'p4'
plm86 dpb86.plm debug object(dpb86) optimize(3) 'p2' 'p3' 'p4'
plm86 util.plm debug object(util) optimize(3) 'p2' 'p3' 'p4'
plm86 timest.plm debug object(timest) optimize(3) 'p2' 'p3' 'p4'
link86 scd.obj,main86,scan,search,sort,disp,util,dpb86,timest to sdir86.lnk
loc86 sdir86.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0),dats(10000h))) ss(stack(+32))
h86 sdir86
(on a micro)
vax sdir86.h86 $fans
gencmd sdir86 data[b1000 m3c5 x800]
* constants are last to force hex generation.
* a minimum data of 3c5h paragraphs is 12K plus the data space
* of SDIR, enough for 512 directory entries
* the max is lowered from 0fffh to 800h
(Aug 12, 1982 for CCP/M-86 IBM PC)
*/
$include (main.plm)


20
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/MON.PLM Normal file
View File

@@ -0,0 +1,20 @@
/* definitions for assembly interface module */
declare
fcb (33) byte external, /* default file control block */
maxb address external, /* top of memory */
buff(128)byte external; /* default buffer */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
end mon2;
mon3: procedure(f,a) address external;
declare f byte, a address;
end mon3;


23
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SCAN.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare
pcb$structure literally 'structure (
state address,
scan$adr address,
token$adr address,
tok$typ byte,
token$len byte,
p$level byte,
nxt$token byte)';
declare
t$null lit '0',
t$param lit '1',
t$op lit '2',
t$mod lit '4',
t$identifier lit '8',
t$string lit '16',
t$numeric lit '32',
t$filespec lit '64',
t$error lit '128';


732
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SCAN.PLM Normal file
View File

@@ -0,0 +1,732 @@
$title ('Utility Command Line Scanner')
scanner:
do;
$include(comlit.lit)
$include(mon.plm)
dcl debug boolean initial (false);
dcl eob lit '0'; /* end of buffer */
$include(fcb.lit)
/* -------- Some routines used for diagnostics if debug mode is on -------- */
printchar: procedure(char) external;
declare char byte;
end printchar;
printb: procedure external;
end printb;
crlf: procedure external;
end crlf;
pdecimal: procedure(v,prec,zerosup) external;
/* print value v, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean, /* zero suppression flag */
d byte; /* current decimal digit */
end pdecimal;
/*
show$buf: procedure;
dcl i byte;
i = 1;
call crlf;
call mon1(9,.('buff = $'));
do while buff(i) <> 0;
i = i + 1;
end;
buff(i) = '$';
call mon1(9,.buff(1));
buff(i) = 0;
end show$buf; */
/* -------- -------- */
white$space: procedure (str$adr) byte;
dcl str$adr address,
str based str$adr (1) byte,
i byte;
i = 0;
do while (str(i) = ' ') or (str(i) = tab);
i = i + 1;
end;
return(i);
end white$space;
delimiter: procedure(char) boolean;
dcl char byte;
if char = '[' or char = ']' or char = '(' or char = ')' or
char = '=' or char = ',' or char = 0 then
return (true);
return(false);
end delimiter;
dcl string$marker lit '05ch';
deblank: procedure(buf$adr);
dcl (buf$adr,dest) address,
buf based buf$adr (128) byte,
(i,numspaces) byte,
string boolean;
string = false;
if (numspaces := white$space(.buf(1))) > 0 then
call move(buf(0) - numspaces + 1,.buf(numspaces+1),.buf(1));
i = 1;
do while buf(i) <> 0;
/* call show$buf;*/
do while ((numspaces := white$space(.buf(i))) = 0 and (buf(i) <> 0))
and not string;
/* call mon1(9,.(cr,lf,'2numspaces = $'));
call pdecimal(numspaces,100,false);*/
/* call show$buf;*/
if buf(i) = '"' then
do;
string = true;
buf(i) = string$marker;
end;
i = i + 1;
end;
do while string and buf(i) <> 0;
if buf(i) = '"' then
if buf(i+1) = '"' then
call move(buf(0) - i + 1,.buf(i+1), .buf(i));
else
do;
buf(i) = string$marker;
string = false;
end;
i = i + 1;
end;
if (numspaces := white$space(.buf(i))) > 0 then
do;
/* call mon1(9,.(cr,lf,'1numspaces = $'));
call pdecimal(numspaces,100,false);*/
buf(i) = ' ';
dest = .buf(i+1); /* save space for ',' */
if i > 1 then
if delimiter(buf(i-1)) or delimiter(buf(i+numspaces)) then
/* write over ' ' with */
dest = dest - 1; /* a = [ ] ( ) */
call move(((buf(0)+1)-(i+numspaces-1)),
.buf(i+numspaces),dest);
if buf(i) = '"' then
string = true;
i = i + 1;
end;
end;
if buf(i - 1) = ' ' then /* no trailing blanks */
buf(i - 1) = 0;
/* if debug then
call show$buf; */
end deblank;
upper$case: procedure (buf$adr);
dcl buf$adr address,
buf based buf$adr (1) byte,
i byte;
i = 0;
do while buf(i) <> eob;
if buf(i) >= 'a' and buf(i) <= 'z' then
buf(i) = buf(i) - ('a' - 'A');
i = i + 1;
end;
end upper$case;
dcl option$max lit '11';
dcl done$scan lit '0ffffh';
dcl ident$max lit '11';
dcl token$max lit '11';
dcl t$null lit '0',
t$param lit '1',
t$option lit '2',
t$modifier lit '4',
t$identifier lit '8',
t$string lit '16',
t$numeric lit '32',
t$filespec lit '64',
t$error lit '128';
dcl pcb$base address;
dcl pcb based pcb$base structure (
state address,
scan$adr address,
token$adr address,
token$type byte,
token$len byte,
p$level byte,
nxt$token byte);
dcl scan$adr address,
inbuf based scan$adr (1) byte,
in$ptr byte,
token$adr address,
token based token$adr (1) byte,
t$ptr byte,
(char, nxtchar, tcount) byte;
digit: procedure (char) boolean;
dcl char byte;
return (char >= '0' and char <= '9');
end digit;
letter: procedure (char) boolean;
dcl char byte;
return (char >= 'A' and char <= 'Z');
end letter;
eat$char: procedure;
char = inbuf(in$ptr := inptr + 1);
nxtchar = inbuf(in$ptr + 1);
end eat$char;
put$char: procedure(charx);
dcl charx byte;
if pcb.token$adr <> 0ffffh then
token(t$ptr := t$ptr + 1) = charx;
end put$char;
get$identifier: procedure (max) byte;
dcl max byte;
tcount = 0;
/* call mon1(9,.(cr,lf,'getindentifier$'));*/
if not letter(char) and char <> '$' then
return(tcount);
do while (letter(char) or digit(char) or char = '_' or
char = '$' ) and tcount <= max;
call put$char(char);
call eat$char;
tcount = tcount + 1;
end;
do while letter(char) or digit(char) or char = '_'
or char = '$' ;
call eat$char;
tcount = tcount + 1;
end;
pcb.token$type = t$identifier;
/* call mon1(9,.(cr,lf,'end of getident$')); */
pcb.token$len = tcount;
return(tcount);
end get$identifier;
file$char: procedure (x) boolean;
dcl x byte;
return(letter(x) or digit(x) or x = '*' or x = '?'
or x = '_' or x = '$');
end file$char;
expand$wild$cards: procedure(field$size) boolean;
dcl (i,leftover,field$size) byte,
save$inptr address;
field$size = field$size + t$ptr;
do while filechar(char) and t$ptr < field$size;
if char = '*' then
do; leftover = t$ptr;
save$inptr = inptr;
call eatchar;
do while filechar(char);
leftover = leftover + 1;
call eatchar;
end;
if leftover >= field$size then /* too many chars */
do; inptr = save$inptr;
return(false);
end;
do i = 1 to field$size - leftover;
call putchar('?');
end;
inptr = save$inptr;
end;
else
call putchar(char);
call eatchar;
end;
return(true);
end expand$wild$cards;
get$file$spec: procedure boolean;
dcl i byte;
do i = 1 to f$name$len + f$type$len;
token(i) = ' ';
end;
if nxtchar = ':' then
if char >= 'A' and char <= 'P' then
do;
call putchar(char - 'A' + 1);
call eat$char; /* skip ':' */
call eat$char; /* 1st char of file name */
end;
else
return(false);
else
call putchar(0); /* use default drive */
if not (letter(char) or char = '$' or char = '_'
or char = '*' or char = '?' ) then /* no leading numerics */
if token(0) = 0 then /* ambiguous with numeric token */
return(false);
if not expand$wild$cards(f$namelen) then
return(false); /* blank name is illegal */
if char = '.' then
do; call eat$char;
if filechar(char) then
do; t$ptr = f$namelen;
if not expand$wild$cards(f$typelen) then
return(false);
end;
end;
pcb.token$len = f$name$len + f$type$len + 1;
pcb.token$type = t$file$spec;
return(true);
end get$file$spec;
get$numeric: procedure(max) boolean;
dcl max byte;
if not digit(char) then
return(false);
do while digit(char) and pcb.token$len <= max and
char <> eob;
call putchar(char);
call eat$char;
pcb.token$len = pcb.token$len + 1;
end;
if char = 'H' or char = 'D' or char = 'B' then
if pcb.token$len < max then
do;
call putchar(char);
call eat$char;
pcb.token$len = pcb.token$len + 1;
end;
else
return(false);
pcb.token$type = t$numeric;
return(true);
end get$numeric;
get$string: procedure(max) boolean;
dcl max byte;
if char <> string$marker then
return(false);
call eatchar;
do while char <> string$marker and char <> eob
and pcb.token$len < token$max;
call putchar(char);
call eatchar;
pcb.token$len = pcb.token$len + 1;
end;
do while char <> string$marker and char <> eob;
call eat$char;
end;
if char <> string$marker then
return(false);
pcb.token$type = t$string;
call eat$char;
return(true);
end get$string;
get$token$all: procedure boolean;
dcl save$inptr byte;
/* call mon1(9,.(cr,lf,'gettokenall$'));*/
save$inptr = in$ptr;
if get$file$spec then
return(true);
/* call mon1(9,.(cr,lf,'gettokenall - no file$')); */
in$ptr = save$inptr - 1; /* need to re-scan, reset buffer pointers */
call eat$char;
t$ptr = 255;
call putchar(0); /* zero drive byte */
if get$identifier(token$max) = 0 then
if not get$string(token$max) then
if not get$numeric(token$max) then
return(false);
/* call mon1(9,.(cr,lf,'end gettokenall$'));*/
return(true);
end get$token$all;
get$modifier: procedure boolean;
if char = ',' or char = ')' or char = 0 then
do;
pcb.token$type = t$modifier or t$null;
return(true);
end;
if get$token$all then
do;
pcb.token$type = pcb.token$type or t$modifier;
return(true);
end;
return(false);
end get$modifier;
get$option: procedure boolean;
call putchar(0);
if get$identifier(token$max) > 0 then
do;
pcb.token$type = pcb.token$type or t$option;
if pcb.token$len > token$max then
pcb.token$len = token$max;
return(true);
end;
return(false);
end get$option;
get$param: procedure boolean;
if char = ',' or char = ')' or char = 0 then
do;
pcb.token$type = t$param or t$null;
return(true);
end;
if get$token$all then
do;
pcb.token$type = pcb.token$type or t$param;
return(true);
end;
return(false);
end get$param;
dcl gotatoken boolean;
dcl parens byte initial (0);
end$state: procedure boolean;
if gotatoken then
do;
pcb.state = .end$state;
return(true);
end;
pcb.token$type = t$null;
pcb.scan$adr = 0ffffh;
return(true);
end end$state;
state8: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state8, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ']' then
do;
call eatchar;
if char = ',' or nxtchar = '(' or nxtchar = ')' then
return(state2);
else if char = 0 then
return(end$state);
else
return(state1);
end;
else if char = ' ' or char = ',' then
do;
call eatchar;
return(state3);
end;
return(state3);
end state8;
state7:procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state7, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ' ' or char = ',' then
do;
call eat$char;
return(state6);
end;
else
if char = ')' then
do;
call eat$char;
return(state8);
end;
return(false);
end state7;
state6: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state6, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.state = .state6;
pcb.nxt$token = t$modifier;
return(true);
end;
if (gotatoken := get$modifier) then
return(state7);
return(false);
end state6;
state5:procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state5, nxtchar = $'));
call printchar(nxtchar); end;
if char = '(' then
do;
call eat$char;
return(state6);
end;
if gotatoken then
do;
pcb.state = .state5;
pcb.nxt$token = t$modifier;
return(true);
end;
if (gotatoken := get$modifier) then
return(state8);
return(false);
end state5;
state4: procedure boolean reentrant;
dcl temp byte;
if debug then do;
call mon1(9,.(cr,lf,'state4, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
temp = char;
call eatchar;
if temp = ',' or temp = ' ' then
return(state3);
if temp = ']' then
if char = '(' or char = ',' or char = ')' then
return(state2);
else if char = 0 then
return(end$state);
else
return(state1);
if temp = '=' then
return(state5);
return(false);
end state4;
state3: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state3, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.state = .state3;
pcb.nxt$token = t$option;
return(true);
end;
if (pcb.plevel := parens ) > 128 then
return(false);
if (gotatoken := get$option) then
return(state4);
return(false);
end state3;
state2: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state2, char = $'));
call printchar(char); end;
do while char = ')' or char = 0;
if char = 0 then
return(end$state);
call eat$char;
parens = parens - 1;
end;
if char = '[' then
do;
call eat$char;
return(state3);
end;
if char = ' ' or char = ',' or char = '(' then
do;
if char = '(' then
parens = parens + 1;
call eat$char;
return(state1);
end;
return(state1);
end state$2;
state1: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state1, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.nxt$token = t$param;
pcb.state = .state1;
return(true);
end;
do while char = '(' ;
parens = parens + 1;
call eat$char;
end;
if (pcb.plevel := parens) > 128 then
return(false);
if (gotatoken := get$param) then
return(state2);
return(false);
end state1;
start$state: procedure boolean;
if char = '@' then do;
debug = true;
call eat$char;
call mon1(9,.(cr,lf,'startstate, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ')' then
return(false);
if char = '(' then
do;
parens = parens + 1;
call eat$char;
return(state1);
end;
if char = '[' then
do;
call eat$char;
return(state3);
end;
if (gotatoken := get$param) then
return(state2);
return(false);
end start$state;
/* display$all: procedure; /* called if debug set */
/* call mon1(9,.(cr,lf,'scanadr=$'));
call pdecimal(pcb.scanadr,10000,false);
call mon1(9,.(', tadr=$'));
call pdecimal(pcb.token$adr,10000, false);
call mon1(9,.(', tlen=$'));
call pdecimal(double(pcb.token$len),100, false);
call mon1(9,.(', ttype=$'));
call pdecimal(double(pcb.token$type),100,false);
call mon1(9,.(', plevel=$'));
call pdecimal(double(pcb.plevel),100,false);
call mon1(9,.(', ntok=$'));
call pdecimal(double(pcb.nxt$token),100,false);
if (pcb.token$type and t$option) <> 0 then
call mon1(9,.(cr,lf,'option =$'));
if (pcb.token$type and t$param) <> 0 then
call mon1(9,.(cr,lf,'parm =$'));
if (pcb.token$type and t$modifier) <> 0 then
call mon1(9,.(cr,lf,'modifier=$'));
if (pcb.token$type and t$filespec) <> 0 then
do;
if fcb(0) = 0 then
call print$char('0');
else call print$char(fcb(0) + 'A' - 1);
call print$char(':');
fcb(12) = '$';
call mon1(9,.fcb(1));
call mon1(9,.(' (filespec)$'));
end;
if ((pcb.token$type and t$string) or (pcb.token$type and
t$identifier) or (pcb.token$type and t$numeric)) <> 0 then
do;
fcb(pcb.token$len + 1) = '$';
call mon1(9,.fcb(1));
end;
if pcb.token$type = t$error then
do;
call mon1(9,.(cr,lf,'scanner error$'));
return;
end;
if (pcb.token$type and t$identifier) <> 0 then
call mon1(9,.(' (identifier)$'));
if (pcb.token$type and t$string) <> 0 then
call mon1(9,.(' (string)$'));
if (pcb.token$type and t$numeric) <> 0 then
call mon1(9,.(' (numeric)$'));
if (pcb.nxt$token and t$option) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = option $'));
if (pcb.nxt$token and t$param) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = parm $'));
if (pcb.nxt$token and t$modifier) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = modifier$'));
call crlf;
end display$all; */
scan: procedure (pcb$adr) public;
dcl status boolean,
pcb$adr address;
pcb$base = pcb$adr;
scan$adr = pcb.scan$adr;
token$adr = pcb.token$adr;
in$ptr, t$ptr = 255;
call eatchar;
gotatoken = false;
pcb.nxt$token = t$null;
pcb.token$len = 0;
if pcb.token$type = t$error then /* after one error, return */
return; /* on any following calls */
else if pcb.state = .start$state then
status = start$state;
else if pcb.state = .state$1 then
status = state$1;
else if pcb.state = .state$3 then
status = state$3;
else if pcb.state = .state$5 then
status = state$5;
else if pcb.state = .state$6 then
status = state$6;
else if pcb.state = .end$state then /* repeated calls go here */
status = end$state; /* after first end$state */
else
status = false;
if not status then
pcb.token$type = t$error;
if pcb.scan$adr <> 0ffffh then
pcb.scan$adr = pcb.scan$adr + inptr;
/* if debug then
call display$all; */
end scan;
scan$init: procedure(pcb$adr) public;
dcl pcb$adr address;
pcb$base = pcb$adr;
call deblank(pcb.scan$adr);
call upper$case(pcb.scan$adr := pcb.scan$adr + 1);
pcb.state = .start$state;
end scan$init;
end scanner;


105
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SCD.A86 Normal file
View File

@@ -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


99
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SCD2.A86 Normal file
View File

@@ -0,0 +1,99 @@
name 'SCD2'
;
; CCP/M 3.1
; Interface for PLM-86 with separate code and data
; Code org'd at 0
; December 18, 1981
dgroup group data,stack
cgroup group code
code cseg
public reset,xdos,mon1,mon2,mon3,mon4
extrn plm:near
org 0h ; for separate code and data
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:
push bp
mov bp,sp
mov dx,4[bp]
mov cx,6[bp]
int 224
pop bp
ret 4
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 03Ah ; reserve patch area biased by
; the 5 bytes the linker inserts
db '161183' ;day, month, year
db 'CCP/M '
db 0,0,0,0 ;patch bits
db 'COPYRT 1983,1984'
db 'DIGITAL RESEARCH'
db 'XXXX-0000-654321' ;serial field
rb 113 ; patch area, 128 total bytes
db 'CSEG patch area'
stack sseg word
rw 64
stack_base rw 0
data dseg ;CP/M page 0 - LOC86'd at 0H
org 4
bdisk rb 1
org 6
maxb rw 1
org 50h
cmdrv rb 1
pass0 rw 1
len0 rb 1
pass1 rw 1
len1 rb 1
org 5ch
fcb rb 16
org 6ch
fcb16 rb 16
org 7ch
cr rb 1
rr rw 1
ro rb 1
org 80h
buff rb 80h
tbuff equ buff
db ' DSEG patch area'
public bdisk,maxb,cmdrv,pass0,len0
public pass1,len1,fcb,fcb16,cr,rr
public ro,buff,tbuff
end


23
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SEARCH.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare /* what kind of file user wants to find */
find$structure lit 'structure (
dir byte,
sys byte,
ro byte,
rw byte,
pass byte,
xfcb byte,
nonxfcb byte,
exclude byte)';
declare
max$search$files literally '10';
declare
search$structure lit 'structure(
drv byte,
name(8) byte,
type(3) byte,
anyfile boolean)'; /* match on any drive if true */


503
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SEARCH.PLM Normal file
View File

@@ -0,0 +1,503 @@
$title ('SDIR - Search For Files')
/* modified 12/12/83 for PC-MODE by G. Edmonds */
search:
do;
/* search module for extended dir */
$include (comlit.lit)
$include (mon.plm)
dcl debug boolean external;
dcl first$pass boolean external;
dcl get$all$dir$entries boolean external;
dcl usr$vector address external;
dcl active$usr$vector address external;
dcl used$de address public; /* used directory entries */
dcl filesfound address public; /* num files collected in memory */
$include(fcb.lit)
$include(xfcb.lit)
declare
sfcb$type lit '21H',
deleted$type lit '0E5H';
$include (search.lit)
dcl find find$structure external; /* what kind of files to look for */
dcl num$search$files byte external;
dcl search (max$search$files) search$structure external;
/* file specs to match on */
/* other globals */
dcl cur$usr byte external,
cur$drv byte external, /* current drive " " */
dir$label byte public; /* directory label for BDOS 3.0 */
/* -------- BDOS calls -------- */
read$char: procedure byte;
return mon2 (1,0);
end read$char;
/* -------- in sort.plm -------- */
mult23: procedure(f$info$index) address external;
dcl f$info$index address;
end mult23;
/* -------- in util.plm -------- */
print: procedure(string$adr) external;
dcl string$adr address;
end print;
print$char: procedure(char) external;
dcl char byte;
end print$char;
pdecimal:procedure(val,prec,zsup) external;
dcl (val, prec) address;
dcl zsup boolean;
end pdecimal;
printfn: procedure(fnameadr) external;
dcl fnameadr address;
end printfn;
crlf: procedure external; /* print carriage return, linefeed */
end crlf;
add3byte: procedure(byte3adr,num) external;
dcl (byte3adr,num) address;
end add3byte;
/* add three byte number to 3 byte accumulater */
add3byte3: procedure(totalb,numb) external;
dcl (totalb,numb) address;
end add3byte3;
/* divide 3 byte value by 8 */
shr3byte: procedure(byte3adr) external;
dcl byte3adr address;
end shr3byte;
/* -------- In dpb86.plm -------- */
$include(dpb.lit)
dcl k$per$block byte external; /* set in dpb module */
base$dpb: procedure external;
end base$dpb;
dpb$byte: procedure(param) byte external;
dcl param byte;
end dpb$byte;
dpb$word: procedure(param) address external;
dcl param byte;
end dpb$word;
/* -------- Some Utility Routines -------- */
check$console$status: procedure byte;
return mon2 (11,0);
end check$console$status;
search$first: procedure (fcb$address) byte public;
declare fcb$address address; /* shared with disp.plm */
return mon2 (17,fcb$address); /* for short display */
end search$first;
search$next: procedure byte public; /* shared with disp.plm */
return mon2 (18,0);
end search$next;
terminate: procedure external; /* in main.plm */
end terminate;
set$vec: procedure(vector,value) external; /* in main.plm */
dcl vector address,
value byte;
end set$vec;
/*break: procedure public; shared with disp.plm */
/* dcl x byte;
if check$console$status then
do;
x = read$char;
call terminate;
end;
end break;*/
/* -------- file information record declaration -------- */
$include(finfo.lit)
declare
buf$fcb$adr address public, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(first$f$i$adr, f$i$adr, last$f$i$adr) address public,
/* indices into file$info array */
file$info based f$i$adr f$info$structure,
sfcb$adr address,
dir$type based sfcb$adr byte,
sfcbs$present byte,
x$i$adr address public,
xfcb$info based x$i$adr x$info$structure;
compare: procedure(length, str1$adr, str2$adr) boolean;
dcl (length,i) byte,
(str1$adr, str2$adr) address,
str1 based str1$adr (1) byte,
str2 based str2$adr (1) byte;
/* str2 is the possibly wildcarded filename we are looking for */
do i = 0 to length - 1;
if ((str1(i) and 7fh) <> (str2(i) and 7fh)) and str2(i) <> '?' then
return(false);
end;
return(true);
end compare;
match: procedure boolean public;
dcl i byte,
temp address;
if (i := (buf$fcb(f$drvusr) and 0fh)) <> cur$usr then
if not get$all$dir$entries then /* Not looking for this user */
return(false); /* and not buffering all other*/
else /* specified user files on */
do; temp = 0; /* this drive. */
call set$vec(.temp,i);
if (temp and usr$vector) = 0 then /* Getting all dir entries, */
return(false); /* with user number corresp'g */
end; /* to a bit on in usr$vector */
if usr$vector <> 0 and i <> 0 and first$pass <> 0 then
call set$vec(.active$usr$vector,i); /* skip cur$usr files */
/* build active usr vector for this drive */
do i = 0 to num$search$files - 1;
if search(i).drv = 0ffh or search(i).drv = cur$drv then
/* match on any drive if 0ffh */
if search(i).anyfile = true then
return(not find.exclude); /* file found */
else if compare(11,.buf$fcb(f$name),.search(i).name(0)) then
return(not find.exclude); /* file found */
end;
return(find.exclude); /* file not found */
end match; /* find.exclude = the exclude option value */
dcl hash$table$size lit '128', /* must be power of 2 */
hash$table (hash$table$size) address at (.memory),
/* must be initialized on each*/
hash$entry$adr address, /* disk scan */
hash$entry based hash$entry$adr address; /* where to put a new entry's */
/* address */
hash$look$up: procedure boolean;
dcl (i,found,hash$index) byte;
hash$index = 0;
do i = f$name to f$namelen + f$typelen;
hash$index = hash$index + (buf$fcb(i) and 7fh); /* attributes may */
end; /* only be set w/ 1st extent */
hash$index = hash$index + cur$usr;
hash$index = hash$index and (hash$table$size - 1);
hash$entry$adr = .hash$table(hash$index); /* put new entry in table if */
f$i$adr = hash$table(hash$index); /* unused ( = 0) */
found = false;
do while f$i$adr <> 0 and not found;
if file$info.usr = (buf$fcb(f$drvusr) and 0fh) and
compare(f$namelen + f$typelen,.file$info.name(0),.buf$fcb(f$name))
then
found = true;
else /* table entry used - collison */
do; hash$entry$adr = .file$info.hash$link; /* resolve by linked */
f$i$adr = file$info.hash$link; /* list */
end;
end;
if f$i$adr = 0 then
return(false); /* didn't find it, used hash$entry to keep new info */
else return(true); /* found it, file$info at matched entry */
end hash$look$up;
$eject
store$file$info: procedure boolean;
/* Look for file name of last found fcb or xfcb in fileinfo */
/* array, if not found put name in fileinfo array. Copy other */
/* info to fileinfo or xfcbinfo. The lookup is hash coded with */
/* collisions handled by linking up file$info records through */
/* the hash$link field of the previous file$info record. */
/* The file$info array grows upward in memory and the xfcbinfo */
/* grows downward. */
/*
-------------------------<---.memory
__ | HASH TABLE |
hash = \ of filename -->| root of file$info list|------------>-----------|
func /__ letters | . | |
| . | |
lower memory ------------------------- <-- first$f$i$adr |
| file$info entry | |
(hash) -----<--| . | <----------------------|
(collision) | | . |
------->| . |
| . |-------------------->|
| last file$info entry | <- last$f$i$adr |
|-----------------------| |
| | |
| | |
| unused by dsearch, | |
| used by dsort | |
| for indices | |
| | |
| | |
|-----------------------| |
| last$xfcb entry | <- x$i$adr |
| . | |
| . | |
| . | <-------------------|
| first xfcb entry |
|-----------------------|
| un-usuable memory | <- maxb
higher memory ------------------------- */
dcl (i, j, d$map$cnt) byte,
temp address,
temp2 address,
incr address,
(s1,s4,s7,s8) byte,
tadd1 address,
tadd2 address;
store$file: procedure;
tadd1=.temp;
tadd2=.temp2;
call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
/* attributes are not in XFCBs to copy again in case */
/* XFCB came first in directory */
file$info.name(f$arc-1) = file$info.name(f$arc-1) and buf$fcb(f$arc);
/* 0 archive bit if it is 0 in any dir entry */
/* count kilobytes for current dir entry */
/* 1 or 2 byte block numbers ? */
if ((buf$fcb(f$diskmap) = buf$fcb(f$diskmap+1)) and
((buf$fcb(f$diskmap) and 80h) = 80h)) and
((buf$fcb(f$drvusr) and 10h) = 0) then do;
dcl s2 based tadd1 (2) byte, /* high middle filesize byte */
s5 based tadd2 (2) byte;
/* must be dos media ... */
/* file size is in the last 4 bytes */
s1 = buf$fcb(f$diskmap+15);
s2(1) = buf$fcb(f$diskmap+14);
s2(0) = buf$fcb(f$diskmap+13);
s4 = buf$fcb(f$diskmap+12);
s5(0) = shr(s4,7) + shl(s2(0),1);
s5(1) = shr(s2(0),7) + shl(s2(1),1); /*calculate # of recs */
s7 = shr(s2(1),7) + shl(s1,1);
file$info.recs$lword=temp2;
file$info.recs$hbyte=s7;
if (shl(s4,1) <> 0) then
call add3byte(.file$info.recs$lword,1);
if ((s4=0) and (shl(s2(0),6)=0)) then
incr = 0;
else incr = 1;
s8 = shr(s2(1),2) + shl(s1,6); /*calculate # of 1k blocks */
s2(0) = shr(s2(0),2) + shl(s2(1),6);
s2(1) = s8;
temp=temp+incr;
file$info.onekblocks=temp;
file$info.kbytes=temp;
end;
else do;
d$map$cnt=0;
i=1;
if dpb$word(blk$max$w) > 255 then
i = 2;
do j = f$diskmap to f$diskmap + diskmaplen - 1 by i;
temp = buf$fcb(j);
if i = 2 then /* word block numbers */
temp = temp or buf$fcb(j+1);
if temp <> 0 then /* allocated */
d$map$cnt = d$map$cnt + 1;
end;
if d$map$cnt > 0 then
do;
call add3byte
(.file$info.recs$lword,
d$map$cnt * (dpb$byte(blkmsk$b) + 1) -
( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b) )
);
file$info.onekblocks = file$info.onekblocks +
d$map$cnt * k$per$block -
shr( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b), 3 );
/* treat each directory entry separately for sparse files */
/* if copied to single density diskette, the number of 1kblocks */
file$info.kbytes = file$info.kbytes + d$map$cnt * k$per$block;
end;
end;
end;
if buf$fcb(f$drvusr) <> sfcb$type then do; /* don't put SFCB's in table */
if not hash$look$up then /* not in table already */
/* hash$entry is where to put adr of new entry */
do; /* copy to new position in file info array */
if (temp := mult23(files$found + 1)) > x$i$adr then
return(false); /* out of memory */
if (temp < first$f$i$adr) then
return(false); /* wrap around - out of memory */
f$i$adr = (last$f$i$adr := last$f$i$adr + size(file$info));
filesfound = filesfound + 1;
call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
file$info.usr = buf$fcb(f$drvusr) and 0fh;
file$info.onekblocks,file$info.kbytes,file$info.recs$lword,
file$info.recs$hbyte, file$info.x$i$adr,file$info.hash$link = 0;
hash$entry = f$i$adr; /* save the address of file$info */
end; /* zero totals for the new file */
end;
/* else hash$lookup has set f$i$adr to the file entry already in the */
/* hash table */
if sfcbs$present then do; /* save sfcb,xfcb or fcb type info */
if (buf$fcb(f$drvusr) and xfcb$type) = 0 then do;
if buf$fcb(f$drvusr) <> sfcb$type then do;
if buf$fcb(f$ex) <= dpb$byte(extmsk$b) then do;
/* first extent? then store sfcb info into xfcb table */
if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
return(false); /* out of memory */
x$i$adr = x$i$adr - size(xfcb$info);
call move(9,sfcb$adr,.xfcb$info.create);
file$info.x$i$adr = x$i$adr;
end;
call store$file;
end;
end;
end;
else do; /* no SFCB's present */
if (buf$fcb(f$drvusr) and xfcb$type) <> 0 then do; /* XFCB */
if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
return(false); /* out of memory */
x$i$adr = x$i$adr - size(xfcb$info);
call move(8,.buf$fcb(xf$create),.xfcb$info.create);
xfcb$info.passmode = buf$fcb(xf$passmode);
file$info.x$i$adr = x$i$adr;
end;
else call store$file; /* must be a regular fcb then */
end;
return(true); /* success */
end store$file$info;
/* Module Entry Point */
get$files: procedure public; /* with one scan through directory get */
dcl dcnt byte; /* files from currently selected drive */
last$f$i$adr = first$f$i$adr - size(file$info);
/* after hash table */
/* last$f$i$adr is the address of the highest file info record */
/* in memory */
do dcnt = 0 to hash$table$size - 1; /* init hash table */
hash$table(dcnt) = 0;
end;
x$i$adr = maxb; /* top of mem, put xfcb info here */
call base$dpb;
dir$label,filesfound = 0;
used$de = 0;
fcb(f$drvusr) = '?'; /* match all dir entries */
dcnt = search$first(.fcb);
sfcb$adr = 96 + .buff; /* determine if SFCB's are present */
if dir$type = sfcb$type then
do;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* initialize buf$fcb */
if ((buf$fcb(f$diskmap) = buf$fcb(f$diskmap+1)) and
((buf$fcb(f$diskmap) and 80h) = 80h)) and
((buf$fcb(f$drvusr) and 10h) = 0) then
used$de=0;
else used$de=shr(1+dpb$word(dirmax$w),2);
sfcbs$present = true;
end;
else
do;
sfcbs$present = false;
used$de=0;
end;
do while dcnt <> 255;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
if sfcbs$present then
sfcb$adr = 97 + (dcnt * 10) + .buff; /* SFCB time & date stamp adr */
if (buf$fcb(f$drvusr) <> deleted$type) then
do;
if buf$fcb(f$drvusr) = dirlabel$type then /* dir label ? */
do;
used$de = used$de + 1;
dir$label = buf$fcb(f$ex); /* save label info */
end;
else
do;
if ((buf$fcb(f$diskmap) = buf$fcb(f$diskmap+1)) and
((buf$fcb(f$diskmap) and 80h) = 80h)) and
((buf$fcb(f$drvusr) and 10h) = 0) then
if (buf$fcb(f$ex) = 0) and (buf$fcb(14)=0) then
used$de=used$de+1;
else ;
else if (buf$fcb(f$drvusr) <> sfcb$type) then
used$de=used$de + 1;
if match then
do;
if not store$file$info then /* store fcb or xfcb info */
do; /* out of space */
call print (.('Out of Memory',cr,lf,'$'));
return;
end;
end;
end;
end;
/*call break;*/
dcnt = search$next; /* to next entry in directory */
end; /* of do while dcnt <> 255 */
end get$files;
search$init: procedure public; /* called once from main.plm */
if (first$f$i$adr := (.hash$table + size(hash$table))) + size(file$info)
> maxb then
do;
call print(.('Not Enough Memory',cr,lf,'$'));
call terminate;
end;
end search$init;
end search;


119
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/SORT.PLM Normal file
View File

@@ -0,0 +1,119 @@
$title ('SDIR - Sort Module')
sort:
do;
/* sort module for extended dir */
$include(comlit.lit)
print: procedure(str$adr) external; /* in util.plm */
dcl str$adr address;
end print;
dcl sorted boolean public; /* set by this module if successful sort */
$include(finfo.lit)
declare
buf$fcb$adr address external, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(f$i$adr, first$f$i$adr, last$f$i$adr, x$i$adr, filesfound)
address external,
/* indices into file$info array */
file$info based f$i$adr f$info$structure,
mid$adr address,
mid$file$info based mid$adr f$info$structure;
mult23: procedure(index) address public;
dcl index address; /* return address of file$info numbered by index */
return shl(index, 4) + shl(index,2) + shl(index,1) + index + first$f$i$adr;
/* index * size(file$info) + base of file$info array */
end mult23;
lessthan: procedure( str1$adr, str2$adr) boolean;
dcl (i,c1,c2) byte, /* true if str1 < str2 */
(str1$adr, str2$adr) address, /* sorting on name and type field */
str1 based str1$adr (1) byte, /* only, assumed to be first in */
str2 based str2$adr (1) byte; /* file$info record */
do i = 1 to 11;
if (c1:=(str1(i) and 7fh)) <> (c2:=(str2(i) and 7fh)) then
return(c1 < c2);
end;
return(false);
end lessthan;
dcl f$i$indices$base address public,
f$i$indices based f$i$indices$base (1) address;
qsort: procedure(l,r); /* no recursive quick sort, sorting largest */
dcl (l,r,i,j,temp) address,/* partition first */
stacksiz lit '14', /* should always be able to sort 2 ** stacksiz */
stack (stack$siz) structure (l address, r address),
sp byte;
sp = 0; stack(0).l = l; stack(0).r = r;
do while sp < stack$siz - 1;
l = stack(sp).l; r = stack(sp).r; sp = sp - 1;
do while l < r;
i = l; j = r;
mid$adr = mult23(f$i$indices(shr(l+r,1)));
do while i <= j;
f$i$adr = mult23(f$i$indices(i));
do while lessthan(f$i$adr,mid$adr);
i = i + 1;
f$i$adr = mult23(f$i$indices(i));
end;
f$i$adr = mult23(f$i$indices(j));
do while lessthan(mid$adr,f$i$adr);
j = j - 1;
f$i$adr = mult23(f$i$indices(j));
end;
if i <= j then
do; temp = f$i$indices(i); f$i$indices(i) = f$i$indices(j);
f$i$indices(j) = temp;
i = i + 1;
if j > 0 then j = j - 1;
end;
end; /* while i <= j */
if j - l < r - i then /* which partition is larger */
do; if i < r then
do; sp = sp + 1; stack(sp).l = i; stack(sp).r = r;
end;
r = j; /* continue sorting left partition */
end;
else
do; if l < j then
do; sp = sp + 1; stack(sp).l = l; stack(sp).r = j;
end;
l = i; /* continue sorting right partition */
end;
end; /* while l < r */
end; /* while sp < stack$siz - 1 */
if sp <> 255 then
call print(.(cr,lf,lf,'Sort Stack Overflow',cr,lf,'$'));
else sorted = true;
end qsort;
sort: procedure public;
dcl i address;
f$i$indices$base = last$f$i$adr + size(file$info);
if filesfound < 2 then
return;
if shr((x$i$adr - f$i$indices$base),1) < filesfound then
do;
call print(.('Not Enough Memory for Sort',cr,lf,'$'));
return;
end;
do i = 0 to filesfound - 1;
f$i$indices(i) = i; /* initialize f$i$indices */
end;
call qsort(0,filesfound - 1);
sorted = true;
end sort;
end sort;


274
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/TCOPY.A86 Normal file
View File

@@ -0,0 +1,274 @@
;*******************************************************
;
; TCOPY - Example program to write the system tracks
; for a Concurrent CP/M Boot Disk on a
; CompuPro Computer System.
;
;*******************************************************
; This program is used to read a binary image file
; which will be loaded on the disk boot tracks. This
; binary image is used to bootstrap the Concurrent CP/M
; system file. The binary image file which TCOPY reads
; has no CMD header and must be fit within the size of
; the boot tracks we are going to write.
; This program is intended to serve as an example
; to be modified by the OEM for differently sized loaders,
; and differently sized system track(s).
; Note: TCOPY must be run under CP/M-86 1.1 and not under
; Concurrent CP/M since TCOPY performs direct BIOS calls to
; write to the disk.
; The following commands are used to generate TCOPY.CMD
; RASM86 TCOPY
; LINK86 TCOPY
;
;*******************************************************
title 'TCOPY - Copy Track 0'
; CP/M-86 function names
; console functions
c_read equ 1
c_writebuf equ 9
; file functions
f_open equ 15
f_readrand equ 33
f_setdma equ 26
f_setdmaseg equ 51
; drive functions
drv_get equ 25
dph_dpb equ 10
dpb_spt equ 0
dpb_off equ 13
; system functions
s_termcpm equ 0
s_bdosver equ 12
s_dirbios equ 50
bdos_version equ 0022h
; direct Bios Parameter Block
bpb_func equ byte ptr 0
bpb_cx equ word ptr 1
bpb_dx equ word ptr 3
; ASCII linefeed and carriage return
lf equ 10
cr equ 13
;-------------------------------------------------------
CSEG
org 0000h
;use CCP stack
mov cl,c_writebuf ;display sign on message
mov dx,offset sign_on_msg
int 224
mov cl,s_bdosver
int 224
cmp ax,bdos_version! je version_ok
mov dx,offset version_msg
jmp error
version_ok:
mov cl,drv_get ;get default drive number
int 224
mov default_drive,al
add al,'A'
mov dest_drive,al ;set drive letter in message
mov cl,f_open ;open the file given as
mov dx,offset fcb ;the 1st command parameter,
int 224 ;it is put at 05CH by
cmp al,0ffh! jne file_ok ;the program load
mov dx,offset open_msg
jmp error
file_ok:
mov current_dma,offset image_buffer
mov r0,0 ;start with sector 0, assume
mov cx,buf_siz/128 ;no CMD header in the file
file_read:
push cx
mov cl,f_setdma
mov dx,current_dma
int 224
mov cl,f_readrand ;user r0,r1,r2 for random
mov dx,offset fcb ;reads
int 224
pop cx
test al,al! jz read_ok
cmp al,1! je track_write
mov dx,offset read_msg
jmp error
read_ok:
add current_dma,128 ;set the DMA for the next sector
inc r0 ;add one to the random record field
loop file_read
mov dx,offset length_msg ;file is larger than the number
jmp error ; of available sectors to write
; We have the binary image in RAM
; Ask for destination diskette
track_write:
inc r0 ;r0 = number of sectors read
next_diskette:
mov cl,c_writebuf
mov dx,offset new_disk_msg
int 224
mov cl,c_read ;wait for a keystroke
int 224
cmp al,3! jne not_ctrlC ;check for control C
jmp done
not_ctrlC:
; Using CP/M-86 function 50, Direct bios call,
; write the track image in IMAGE_BUFFER to
; track 0, on default drive.
mov cl,default_drive
call select_disk ;select default drive
mov bx,es:dph_dpb[bx] ;get DPB
mov ax,es:dpb_spt[bx] ;get sectors/track
add ax,26 ;add in sectors for track 0
cmp ax,r0! jae size_ok ;check max # of sectors on boot tracks
mov dx,offset length_msg ; file is larger than the number
jmp error ; of available sectors to write
size_ok:
mov ax,es:dpb_off[bx] ;determine sides from OFF value
cmp ax,2! je format_ok
cmp ax,4! je format_ok
mov dx,offset format_msg
jmp error
format_ok:
shr al,1
mov second_track,al ;save track # for cylinder 1, head 0
xor cx,cx
call set_track ;set track to 0
call set_dmaseg ;set DMA segment = DS
mov current_sector,0 ;sectors are relative to 0 in BIOS
mov current_dma,offset image_buffer
mov cx,r0 ;number of 128 byte sectors to write
next_sector:
push cx ;save sector count
call set_dmaoff
call set_sector
call write_sector
add current_dma,128 ;next area of memory to write
inc current_sector ;next sector number
cmp current_sector,26
jb same_track
mov cl,second_track ;cylinder 1, head 0
call set_track
mov current_sector,0
same_track:
pop cx ;restore sector count
loop next_sector
mov cl,c_writebuf ;does the user want to write
mov dx,offset continue_msg ;to another diskette ?
int 224
mov cl,c_read ;get response
int 224
and al,05FH ;make upper case
cmp al,'Y'
jne done
jmp next_diskette
error:
push dx
call crlf
pop dx
mov cl,c_writebuf
int 224
done:
mov cx,s_termcpm
mov dx,cx
int 224
select_disk:
mov al,9 ;BIOS function number of seldsk
xor dx,dx
jmps bios
set_track:
mov al,10 ;BIOS function number of settrk
jmps bios
set_dmaseg:
mov al,17 ;BIOS function number of setdmab
mov cx,ds ;dma segment we want to use
jmps bios
set_dmaoff:
mov al,12 ;BIOS function number of setdma
mov cx,current_dma
jmps bios
set_sector:
mov al,11 ;BIOS function number of setsec
mov cx,current_sector
jmps bios
write_sector:
mov al,14 ;BIOS function number of write sector
jmps bios ;error checking can be added here
bios:
mov bx,offset bpb ;fill in BIOS Paramenter Block
mov bpb_func[bx],al
mov bpb_cx[bx],cx
mov bpb_dx[bx],dx
mov cl,s_dirbios
mov dx,bx
int 224
ret
crlf:
mov dx,offset crlf_msg
mov cl,c_writebuf
int 224
ret
;-------------------------------------------------------
DSEG
org 0000h
fcb equ ds:byte ptr .05Ch
r0 equ ds:word ptr .07Dh
r3 equ ds:byte ptr .07Fh
sign_on_msg db cr,lf,'Example TCOPY for CompuPro Computer System'
db cr,lf,'Writes track image file on boot tracks$'
new_disk_msg db cr,lf,'Put destination diskette in drive '
dest_drive db 'A:'
db cr,lf,'Strike any key when ready $'
continue_msg db cr,lf,'Write another disk (Y/N) ? $'
crlf_msg db cr,lf,'$'
version_msg db 'Requires CP/M-86 1.1$'
format_msg db 'Unrecognized disk format$'
open_msg db 'Give file name containing boot '
db 'image, after TCOPY command$'
read_msg db 'Error reading track image file$'
length_msg db 'File is larger than the the number of boot sectors$'
write_msg db 'Error writing on boot tracks$'
image_buffer rb 26*128+8*8*128 ;area for both tracks
buf_siz equ offset $ - offset image_buffer
bpb rb 5 ;direct Bios Parameter Block
current_dma dw 0
current_sector dw 0
default_drive db 0
second_track db 0
END


226
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/TIMEST.PLM Normal file
View File

@@ -0,0 +1,226 @@
$title('SDIR - Display Time Stamps')
timestamp:
do;
/* Display time stamp module for extended directory */
/* Time & Date ASCII Conversion Code */
/* From MP/M 1.1 TOD program */
$include(comlit.lit)
print$char: procedure (char) external;
declare char byte;
end print$char;
terminate: procedure external;
end terminate;
declare tod$adr address;
declare tod based tod$adr structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (21) byte );
declare string$adr address;
declare string based string$adr (1) byte;
declare index byte;
emitchar: procedure(c);
declare c byte;
string(index := index + 1) = c;
end emitchar;
emitn: procedure(a);
declare a address;
declare c based a byte;
do while c <> '$';
string(index := index + 1) = c;
a = a + 1;
end;
end emitn;
emit$bcd: procedure(b);
declare b byte;
call emitchar('0'+b);
end emit$bcd;
emit$bcd$pair: procedure(b);
declare b byte;
call emit$bcd(shr(b,4));
call emit$bcd(b and 0fh);
end emit$bcd$pair;
emit$colon: procedure(b);
declare b byte;
call emit$bcd$pair(b);
call emitchar(':');
end emit$colon;
emit$bin$pair: procedure(b);
declare b byte;
call emit$bcd(b/10); /* makes garbage if not < 10 */
call emit$bcd(b mod 10);
end emit$bin$pair;
emit$slant: procedure(b);
declare b byte;
call emit$bin$pair(b);
call emitchar('/');
end emit$slant;
declare
base$year lit '78', /* base year for computations */
base$day lit '0', /* starting day for base$year 0..6 */
month$days (*) address data
/* jan feb mar apr may jun jul aug sep oct nov dec */
( 000,031,059,090,120,151,181,212,243,273,304,334);
leap$days: procedure(y,m) byte;
declare (y,m) byte;
/* compute days accumulated by leap years */
declare yp byte;
yp = shr(y,2); /* yp = y/4 */
if (y and 11b) = 0 and month$days(m) < 59 then
/* y not 00, y mod 4 = 0, before march, so not leap yr */
return yp - 1;
/* otherwise, yp is the number of accumulated leap days */
return yp;
end leap$days;
declare word$value address;
get$next$digit: procedure byte;
/* get next lsd from word$value */
declare lsd byte;
lsd = word$value mod 10;
word$value = word$value / 10;
return lsd;
end get$next$digit;
bcd:
procedure (val) byte;
declare val byte;
return shl((val/10),4) + val mod 10;
end bcd;
declare (month, day, year, hrs, min, sec) byte;
bcd$pair: procedure(a,b) byte;
declare (a,b) byte;
return shl(a,4) or b;
end bcd$pair;
compute$year: procedure;
/* compute year from number of days in word$value */
declare year$length address;
year = base$year;
do while true;
year$length = 365;
if (year and 11b) = 0 then /* leap year */
year$length = 366;
if word$value <= year$length then
return;
word$value = word$value - year$length;
year = year + 1;
end;
end compute$year;
declare
week$day byte, /* day of week 0 ... 6 */
day$list (*) byte data
('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
leap$bias byte; /* bias for feb 29 */
compute$month: procedure;
month = 12;
do while month > 0;
if (month := month - 1) < 2 then /* jan or feb */
leapbias = 0;
if month$days(month) + leap$bias < word$value then return;
end;
end compute$month;
declare
date$test byte, /* true if testing date */
test$value address; /* sequential date value under test */
get$date$time: procedure;
/* get date and time */
hrs = tod.hrs;
min = tod.min;
sec = tod.sec;
word$value = tod.date;
/* word$value contains total number of days */
week$day = (word$value + base$day - 1) mod 7;
call compute$year;
/* year has been set, word$value is remainder */
leap$bias = 0;
if (year and 11b) = 0 and word$value > 59 then
/* after feb 29 on leap year */ leap$bias = 1;
call compute$month;
day = word$value - (month$days(month) + leap$bias);
month = month + 1;
end get$date$time;
emit$date$time: procedure;
if tod.opcode = 0 then
do;
call emitn(.day$list(shl(week$day,2)));
call emitchar(' ');
end;
call emit$slant(month);
call emit$slant(day);
call emit$bin$pair(year);
call emitchar(' ');
call emit$colon(hrs);
call emit$colon(min);
if tod.opcode = 0 then
call emit$bcd$pair(sec);
end emit$date$time;
tod$ASCII:
procedure (parameter);
declare parameter address;
declare ret address;
ret = 0;
tod$adr = parameter;
string$adr = .tod.ASCII;
if (tod.opcode = 0) or (tod.opcode = 3) then
do;
call get$date$time;
index = -1;
call emit$date$time;
end;
else
call terminate; /* error */
end tod$ASCII;
declare lcltod structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (21) byte );
display$time$stamp: procedure (tsadr) public;
dcl tsadr address,
i byte;
lcltod.opcode = 3; /* display time and date stamp, no seconds */
call move (4,tsadr,.lcltod.date); /* don't copy seconds */
call tod$ASCII (.lcltod);
do i = 0 to 13;
call printchar (lcltod.ASCII(i));
end;
end display$time$stamp;
dcl last$data$byte byte initial(0);
end timestamp;


149
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/UTIL.PLM Normal file
View File

@@ -0,0 +1,149 @@
$title('SDIR - Utility Routines')
utility:
do;
/* Utility Module for SDIR */
$include(comlit.lit)
/* -------- arithmetic functions -------- */
add3byte: procedure(byte3adr,num) public;
dcl (byte3adr,num) address,
b3 based byte3adr structure (
lword address,
hbyte byte),
temp address;
temp = b3.lword;
if (b3.lword := b3.lword + num) < temp then /* overflow */
b3.hbyte = b3.hbyte + 1;
end add3byte;
/* add three byte number to 3 byte value structure */
add3byte3: procedure(totalb,numb) public;
dcl (totalb,numb) address,
num based numb structure (
lword address,
hbyte byte),
total based totalb structure (
lword address,
hbyte byte);
call add3byte(totalb,num.lword);
total.hbyte = num.hbyte + total.hbyte;
end add3byte3;
/* divide 3 byte value by 8 */
shr3byte: procedure(byte3adr) public;
dcl byte3adr address,
b3 based byte3adr structure (
lword address,
hbyte byte),
temp1 based byte3adr (2) byte,
temp2 byte;
temp2 = ror(b3.hbyte,3) and 11100000b; /* get 3 bits */
b3.hbyte = shr(b3.hbyte,3);
b3.lword = shr(b3.lword,3);
temp1(1) = temp1(1) or temp2; /* or in 3 bits from hbyte */
end shr3byte;
/* ------- print routines -------- */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
/*break: procedure external;
end break;*/
$include(fcb.lit)
/* BDOS calls */
print$char: procedure(char) public;
declare char byte;
call mon1(2,char);
end print$char;
print: procedure(string$adr) public;
dcl string$adr address;
call mon1(9,string$adr);
end print;
printb: procedure public;
call print$char(' ');
end printb;
crlf: procedure public;
call print$char(cr);
call print$char(lf);
end crlf;
printfn: procedure(fname$adr) public;
dcl fname$adr address,
file$name based fname$adr (1) byte,
i byte; /* <filename> ' ' <filetype> */
do i = 0 to f$namelen - 1;
call printchar(file$name(i) and 7fh);
end;
call printchar(' ');
do i = f$namelen to f$namelen + f$typelen - 1;
call printchar(file$name(i) and 7fh);
end;
end printfn;
pdecimal: procedure(v,prec,zerosup) public;
/* print value v, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean, /* zero suppression flag */
d byte; /* current decimal digit */
do while prec <> 0;
d = v / prec; /* get next digit */
v = v mod prec; /* get remainder back to v */
prec = prec / 10; /* ready for next digit */
if prec <> 0 and zerosup and d = 0 then
call printb;
else
do;
zerosup = false;
call printchar('0'+d);
end;
end;
end pdecimal;
p3byte: procedure(byte3adr,prec) public;
/* print 3 byte value with 0 suppression */
dcl byte3adr address, /* assume high order bit is < 10 */
prec address,
b3 based byte3adr structure (
lword address,
hbyte byte),
i byte;
/* prec = 1 for 6 chars, 2 for 7 */
if b3.hbyte <> 0 then
do;
call pdecimal(b3.hbyte,prec,true); /* 3 for 8 chars printed */
call pdecimal(b3.lword,10000,false);
end;
else
do;
i = 1;
do while i <= prec;
call printb;
i = i * 10;
end;
call pdecimal(b3.lword,10000,true);
end;
end p3byte;
end utility;


9
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/VERS.LIT Normal file
View File

@@ -0,0 +1,9 @@
declare
bdos20 lit '20h',
bdos22 lit '22h',
bdos30 lit '30h',
mpm lit '01h',
cpm86 lit '10h',
mpm86 lit '11h',
ccpm86 lit '14h';


23
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/XFCB.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare /* XFCB */
xfcb$type lit '10h', /* identifier on disk */
xf$passmode lit '12', /* pass word protection mode */
xf$pass lit '16', /* XFCB password */
passlen lit '8', /* password length */
xf$create lit '24', /* creation/access time stamp */
xf$update lit '28'; /* update time stamp */
declare /* directory label: special case of XFCB */
dirlabeltype lit '20h', /* identifier on disk */
dl$password lit '128', /* masks on data byte */
dl$access lit '64',
dl$update lit '32',
dl$makexfcb lit '16',
dl$exists lit '1';
declare /* password mode of xfcb */
pm$read lit '80h',
pm$write lit '40h',
pm$delete lit '20h';


71
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/ASM86.CPM Normal file
View File

@@ -0,0 +1,71 @@
$ !
$ ! Here (vaxmake.com) is the command file for building all of
$ ! DRI's ASM86 on the VAX. This file is set up to be SUBMITed.
$ !
$ set def [.cmsasm86]
$ assign nl: sys$print
$
$! Assign the Intel disk names and old crosscompiler tool names.
$ @oldintel
$!
$ oplm86 mainp.plm debug optimize(2) xref
$ oplm86 brexpr.plm debug optimize(2) xref
$ oplm86 cm.plm debug optimize(2) xref
$ oplm86 cm2.plm debug optimize(2) xref
$ oplm86 cmac1.plm debug optimize(2) xref
$ oplm86 cmac2.plm debug optimize(2) xref
$ oplm86 cmac3.plm debug optimize(2) xref
$ oplm86 cmac4.plm debug optimize(2) xref
$ oplm86 cmac5.plm debug optimize(2) xref
$ oplm86 cmsubr.plm debug optimize(2) xref
$ oplm86 dline.plm debug optimize(2) xref
$ oplm86 ermod.plm debug optimize(2) xref
$ oplm86 expr.plm debug optimize(2) xref
$ oplm86 files.plm debug optimize(2) xref
$ oplm86 global.plm debug optimize(2) xref
$ oplm86 instr.plm debug optimize(2) xref
$ oplm86 io.plm debug optimize(2) xref
$ oplm86 mnem1.plm debug optimize(2) xref
$ oplm86 mnem2.plm debug optimize(2) xref
$ oplm86 mnem3.plm debug optimize(2) xref
$ oplm86 mnem4.plm debug optimize(2) xref
$ oplm86 outp.plm debug optimize(2) xref
$ oplm86 predef.plm debug optimize(2) xref
$ oplm86 print.plm debug optimize(2) xref
$ oplm86 pseud1.plm debug optimize(2) xref
$ oplm86 pseud2.plm debug optimize(2) xref
$ oplm86 scan.plm debug optimize(2) xref
$ oplm86 subr1.plm debug optimize(2) xref
$ oplm86 subr2.plm debug optimize(2) xref
$ oplm86 symb.plm debug optimize(2) xref
$ oplm86 text.plm debug optimize(2) xref
$
$ oasm86 c86lnk.asm debug
$ !
$ olink86 cmac1.obj,cmac2.obj,cmac3.obj,cmac4.obj,cmac5.obj to f11.mod
$ olink86 mnem1.obj,mnem2.obj,mnem3.obj,mnem4.obj,symb.obj to f12.mod
$ olink86 io.obj,subr1.obj,subr2.obj,files.obj,scan.obj to f13.mod
$ olink86 print.obj,predef.obj,ermod.obj,text.obj,outp.obj to f14.mod
$ olink86 expr.obj,brexpr.obj,pseud1.obj,pseud2.obj,cmsubr.obj to f15.mod
$ olink86 instr.obj,dline.obj,global.obj,cm.obj,cm2.obj to f16.mod
$ olink86 f11.mod,f12.mod,f13.mod to f21.mod
$ olink86 f14.mod,f15.mod,f16.mod to f22.mod
$ olink86 c86lnk.obj,mainp.obj,f21.mod,f22.mod,plm86.lib to asm86.mod
$ oloc86 asm86.mod to asm86.abs ad(sm(code(0))) od(sm(code,const,stack))
$ oh86 asm86.abs
$!
$! search for the starts of the CONST and MEMORY segments...
$ search asm86.mp2 "G CONST","G MEMORY"
$!
$! Do the rest on CP/M:
$!
$! Determine BBB, MMM and NNN from asm86.mp2 (from the output from
$! the search command):
$! BBB = start of const segment / 16
$! MMM = start of memory segment / 16
$! Then NNN = (MMM - BBB) + 100h
$! (100h leaves 4K bytes of space for the symbol table)
$! gencmd asm86 data[bBBB,mNNN,xFFF]
$! An example:
$! gencmd asm86 data[b4AD,m44E,xFFF]


20
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/BNF.TEX Normal file
View File

@@ -0,0 +1,20 @@
/*********** "BNF"-expression syntax ************/
/*
E::= E xor A !! E or A !! A
A::= A and N !! N
N::= not N !! R
R::= P eq P !! P lt P !! P le P !! P gt P !! P ge P !! P ne P !! P
P::= P + T !! P - T !! T
T::= T * M !! T / M !! T mod M !! T shl M !! T shr M !! M
M::= - M !! + M !! S
S::= <over>: F !! F
F::= F ptr B !! seg B !! offset B !! type B !!
length B !! last B !! B
B::= ( E ) !! [ bracket-expression ] !! I
I::= varaible !! . number !! number !! label !! string
<over>::= segment register
(stringlength < 3)
*/


125
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/BREXPR.X86 Normal file
View File

@@ -0,0 +1,125 @@
$nolist
/*
modified 4/13/81 R. Silberstein
*/
/* Symbol types : */
dcl
reg lit '0', /* register */
pseudo lit '1', /* pseudo instruction */
code lit '2', /* instruction */
string lit '3', /* character string */
spec lit '4', /* special character */
number lit '5', /* 8 or 16 bit number */
variable lit '6',
lab lit '7', /* label */
operator lit '8', /* operator in expressions */
doubledefined lit '0f9h', /* doubled defined symbol */
neglected lit '0fah', /* neglected symb.,never to be def. */
ident lit '0fbh', /* identificator, scanner output */
udefsymb lit '0fdh', /* undefined symbol */
symbol lit '0feh', /* variable,label or undef. symb. */
deletedsymb lit '0ffh'; /* deleted symbol (not used */
/* Symbol description values */
dcl
nil lit '0', /* no specification */
byt lit '1', /* symbol is 8-bit type */
wrd lit '2', /* symbol is 16 bit type */
dwrd lit '4'; /* symbol is 2*16 bit type
or a segment register */
/* Register values : */
dcl
rbx lit '3',
rbp lit '5',
rsi lit '6',
rdi lit '7',
res lit '0', /* segment registers */
rcs lit '1',
rss lit '2',
rds lit '3';
/* Symbolic operators */
dcl
oshort lit '0', /* 8-bit value of expression */
oor lit '1', /* logical OR */
oxor lit '2', /* logical XOR */
oand lit '3', /* logical AND */
onot lit '4', /* logical NOT */
oeq lit '5', /* equal */
ogt lit '6', /* greater */
oge lit '7', /* greater or equal */
olt lit '8', /* less */
ole lit '9', /* less or equal */
one lit '10', /* not equal */
omod lit '11', /* arithmetic MOD */
oshl lit '12', /* shift left */
oshr lit '13', /* shift rigth */
optr lit '14', /* take type of 1. op, value of 2. */
ooffset lit '15', /* offset value of operand */
oseg lit '16', /* segment value of operand */
otype lit '17', /* type value of operand */
olength lit '18', /* length attribute of variables */
olast lit '19', /* length - 1 */
leftbracket lit '''[''',
rightbracket lit ''']''';
dcl
operandstruc lit 'struc(
length addr,
stype byte,
sflag byte,
segment addr,
offset addr,
baseindex byte)',
/* define bits of SFLAG of structures above */
type$bit lit '7h', /* bit 0-2 */
segtypebit lit '18h', /* bit 3-4 */
segmbit lit '20h', /* bit 5 */
iregbit lit '40h', /* bit 6 */
bregbit lit '80h', /* bit 7 */
/* left-shift counters */
typecount lit '0',
segtypecount lit '3',
segmcount lit '5',
iregcount lit '6',
bregcount lit '7',
/* define bits of BASEINDEX byte of structures above */
indexregbit lit '01h', /* bit 0 */
baseregbit lit '02h', /* bit 1 */
nooverridebit lit '40h', /* bit 6 */
/* left shift counters */
indexregcount lit '0',
baseregcount lit '1',
noovercount lit '6';
scan: proc external;
end scan;
specialtoken: proc (tok) byte external;
dcl tok byte;
end specialtoken;
$list


78
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/C86LNK.ASM Normal file
View File

@@ -0,0 +1,78 @@
;
extrn asm86:near
cgroup group code
dgroup group const,data,stack,memory
assume cs:cgroup,ds:dgroup
data segment public 'DATA'
data ends
;
stack segment word stack 'STACK'
stack_base label byte
stack ends
;
memory segment memory 'MEMORY'
memory ends
const segment public 'CONST'
public fcb,fcb16,tbuff,endbuf
org 6
endbuf equ $
org 5ch
fcb equ $
org 6ch
fcb16 equ $
org 80h
tbuff equ $
org 100h
const ends
code segment public 'CODE'
public mon1,mon2
start: mov ax,ds
pushf
pop bx
cli
mov ss,ax
lea sp,stack_base
push bx
popf
jmp asm86
copyright db ' COPYRIGHT (C) DIGITAL RESEARCH, 1981 '
public patch
patch:
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
db 90h,90h,90h,90h,90h,90h,90h,90h
date db ' 01/25/82 '
bdos:
pop ax ; return address
pop dx
pop cx
push ax
int 224
ret
mon1 equ bdos
mon2 equ bdos
code ends
end


37
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CM.EXT Normal file
View File

@@ -0,0 +1,37 @@
$nolist
codemacro$rout: PROC external;
end$proc codemacro$rout;
db$cm$rout: PROC external;
end$proc db$cm$rout;
dw$cm$rout: PROC external;
end$proc dw$cm$rout;
dd$cm$rout: PROC external;
end$proc dd$cm$rout;
segfix$cm$rout: PROC external;
end$proc segfix$cm$rout;
nosegfix$cm$rout: PROC external;
end$proc nosegfix$cm$rout;
modrm$cm$rout: PROC external;
end$proc modrm$cm$rout;
relb$cm$rout: PROC external;
end$proc relb$cm$rout;
relw$cm$rout: PROC external;
end$proc relw$cm$rout;
dbit$cm$rout: PROC external;
end$proc dbit$cm$rout;
end$cm$rout: PROC external;
end$proc end$cm$rout;
$list


16
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CM.LIT Normal file
View File

@@ -0,0 +1,16 @@
$nolist
/* D E C L A R A T I O N F O R "C O D E M A C R O" P A R T
Extended version of ASM86 */
dcl comma lit ''',''',
colon lit ''':''',
first lit '0',
second lit '1',
leftpar lit '''(''',
rightpar lit ''')''';
$list


47
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CM2.EXT Normal file
View File

@@ -0,0 +1,47 @@
$nolist
/* D E C L A R A T I O N F O R "C O D E M A C R O" P A R T
Extended version of ASM86 */
dcl cm$error byte external,
global$cm$error byte external,
cm$list$overflow byte external,
cmpt address external;
/* level 2 in the syntax-tree of codemacro building */
/* Procedure to initialize temporary storage and pointers
conserning the building of codemacro */
init$cm$rout: PROC external;
end$proc init$cm$rout;
name$rout: PROC byte external;
end$proc name$rout;
formal$list$rout: PROC external;
end$proc formal$list$rout;
terminate$cm$rout: PROC external;
end$proc terminate$cm$rout;
legal$parameter: PROC(lg,ptr,ptr2) byte external;
dcl lg byte,
(ptr,ptr2) address;
end$proc legal$parameter;
legal$seg$reg: PROC byte external;
end$proc legal$seg$reg;
put$b: PROC(b) external;
dcl b byte;
end$proc put$b;
put$w: PROC(w) external;
dcl w address;
end$proc put$w;
$list


44
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CMAC.LIT Normal file
View File

@@ -0,0 +1,44 @@
$nolist
/* Literals used in codemacro specification : */
dcl
divisor lit '0',
mplier lit '0',
place lit '0',
itype lit '0',
si$ptr lit '0',
di$ptr lit '1',
port lit '1',
adr lit '0',
dst lit '0',
src lit '1',
opcode lit '0';
/* Literals to simplify table punching: */
dcl
cmachead lit 'struc (next address,nopar byte',
cmac2struc lit 'cmachead,body(2) byte)',
cmac3struc lit 'cmachead,body(3) byte)',
cmac4struc lit 'cmachead,body(4) byte)',
cmac5struc lit 'cmachead,body(5) byte)',
cmac6struc lit 'cmachead,body(6) byte)',
cmac7struc lit 'cmachead,body(7) byte)',
cmac8struc lit 'cmachead,body(8) byte)',
cmac9struc lit 'cmachead,body(9) byte)',
cmac10struc lit 'cmachead,body(10) byte)',
cmac11struc lit 'cmachead,body(11) byte)',
cmac12struc lit 'cmachead,body(12) byte)',
cmac13struc lit 'cmachead,body(13) byte)',
cmac14struc lit 'cmachead,body(14) byte)',
cmac15struc lit 'cmachead,body(15) byte)',
cmac16struc lit 'cmachead,body(16) byte)',
cmac17struc lit 'cmachead,body(17) byte)',
cmac18struc lit 'cmachead,body(18) byte)',
cmac19struc lit 'cmachead,body(19) byte)',
cmac20struc lit 'cmachead,body(20) byte)',
cmac21struc lit 'cmachead,body(21) byte)';
$list


96
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CMACD.LIT Normal file
View File

@@ -0,0 +1,96 @@
$nolist
$eject
/* Here are the definitions for the */
/* codemacro instructions of the */
/* ASM86 assembler */
/* Commands within codemacros: */
declare
mdbn lit '0', /* DB with number */
mdbf lit '1', /* DB with formal parameter */
mdwn lit '2', /* DW with numbers */
mdwf lit '3', /* DW with formal parameter */
mddf lit '4', /* DD with formal parameter */
mdbit lit '5', /* DBIT */
mendm lit '6', /* ENDM */
mrelb lit '7', /* RELB */
mrelw lit '8', /* RELW */
mendbit lit '9', /* ENDBIT */
mmodrm1 lit '10', /* MODRM with 1 formal parameter */
mmodrm2 lit '11', /* MODRM with 2 formal parmeters */
msegfix lit '12', /* SEGFIX */
mnosegfix lit '13', /* NOSEGFIX */
mformalbits lit '14', /* define bits from formal par. */
mnumberbits lit '15'; /* define bits from number */
/* Specifier letters: */
declare
specA lit '0', /* accumulator, AX or AL */
specC lit '1', /* code, address expression */
specD lit '2', /* data, number used as immediate data */
specE lit '3', /* effective address, either a memory
address (specM) or register (specR) */
specM lit '4', /* memory address, variable (with or without
indexing) or [register expression] */
specR lit '5', /* general register only (not segment) */
specS lit '6', /* segment register */
specX lit '7'; /* simple variable name without indexing */
/* Modifier letters: */
declare
nomod lit '0',
modb lit '1', /* byte expression */
modw lit '2', /* word expression */
modsb lit '3', /* byte in range (-128,127) */
modd lit '4'; /* 2-word expression */
/* Segment override bytes: */
dcl
ESover lit '26h',
CSover lit '2eh',
SSover lit '36h',
DSover lit '3eh';
/* "AND"-masks for codemaco head flag */
declare
nopar$and lit '0fh', /* no of parameters, bit 0-3 */
prefix$and lit '10h'; /* prefix flag, bit 4 */
/* "OR"-masks for codemacro head flag */
declare
prefix$on lit '10h'; /* PREFIX on flag */
/* "AND"-masks for modifier-letter/range spec. byte */
declare
modletter$bit lit '07h', /* bits 0-2 */
range$spec$bit lit '0f8h', /* bits 3-7 */
modlettercount lit '0', /* bit position counters */
rangespeccount lit '3';
/* "OR"-masks for range-specifier bits */
declare
norange lit '0', /* no range specfier (bits 3-4) */
singlerange lit '08h', /* single range */
doublerange lit '10h', /* double range */
rangeand lit '18h',
number$range lit '0', /* bit 5 */
register$range lit '20h',
rangetypeand lit '20h';
$list


118
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CMLINK.EXT Normal file
View File

@@ -0,0 +1,118 @@
$nolist
/*
modified 6/16/81 R. Silberstein
*/
declare
aaa1 byte external,
aad1 byte external,
aam1 byte external,
aas1 byte external,
adc11 byte external,
add11 byte external,
and10 byte external,
call3 byte external,
callf2 byte external,
cbw1 byte external,
clc1 byte external,
cld1 byte external,
cli1 byte external,
cmc1 byte external,
cmp11 byte external,
cmps2 byte external,
CMPSB1 BYTE EXTERNAL,
CMPSW1 BYTE EXTERNAL,
cwd1 byte external,
daa1 byte external,
das1 byte external,
dec3 byte external,
div2 byte external,
esc3 byte external,
hlt1 byte external,
idiv2 byte external,
imul2 byte external,
in4 byte external,
inc3 byte external,
int2 byte external,
into1 byte external,
iret1 byte external,
ja1 byte external,
jae1 byte external,
jb1 byte external,
jbe1 byte external,
jcxz1 byte external,
je1 byte external,
jg1 byte external,
jge1 byte external,
jl1 byte external,
jle1 byte external,
jmp2 byte external,
jmpf2 byte external,
jmps1 byte external,
jne1 byte external,
jno1 byte external,
jnp1 byte external,
jns1 byte external,
jo1 byte external,
jp1 byte external,
js1 byte external,
lahf1 byte external,
lds1 byte external,
les1 byte external,
lea1 byte external,
lock1 byte external,
lods2 byte external,
LODSB1 BYTE EXTERNAL,
LODSW1 BYTE EXTERNAL,
loop1 byte external,
loope1 byte external,
loopne1 byte external,
mov17 byte external,
movs2 byte external,
MOVSB1 BYTE EXTERNAL,
MOVSW1 BYTE EXTERNAL,
mul2 byte external,
neg2 byte external,
nop1 byte external,
not2 byte external,
or10 byte external,
out4 byte external,
pop4 byte external,
popf1 byte external,
push3 byte external,
pushf1 byte external,
rcl4 byte external,
rcr4 byte external,
rep1 byte external,
repe1 byte external,
repne1 byte external,
ret3 byte external,
retf3 byte external,
rol4 byte external,
ror4 byte external,
sahf1 byte external,
sal4 byte external,
sar4 byte external,
sbb11 byte external,
scas2 byte external,
SCASB1 BYTE EXTERNAL,
SCASW1 BYTE EXTERNAL,
shr4 byte external,
stc1 byte external,
std1 byte external,
sti1 byte external,
stos2 byte external,
STOSB1 BYTE EXTERNAL,
STOSW1 BYTE EXTERNAL,
sub11 byte external,
test10 byte external,
wait1 byte external,
xchg6 byte external,
xlat1 byte external,
xor10 byte external;
$list


57
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CMSUBR.EXT Normal file
View File

@@ -0,0 +1,57 @@
$nolist
clearcmindex: proc external;
end clearcmindex;
emit: proc external; /* emit codebytes for an instruction */
end emit;
emitdummies: proc external; /* emit dummy (NO-OPs) bytes if error */
end emitdummies;
commandtype: proc(comno,lg,pt) byte external;
dcl (comno,lg) byte,pt address;
end commandtype;
mDBNrout: proc external;
end mDBNrout;
mDBFrout: proc external;
end mDBFrout;
mDWNrout: proc external;
end mDWNrout;
mDWFrout: proc external;
end mDWFrout;
mDDFrout: proc external;
end mDDFrout;
mRELBrout: proc external;
end mRELBrout;
mRELWrout: proc external;
end mRELWrout;
mNOSEGFIXrout: proc external;
end mNOSEGFIXrout;
mSEGFIXrout: proc external;
end mSEGFIXrout;
mMODRM1rout: proc external;
end mMODRM1rout;
mMODRM2rout: proc external;
end mMODRM2rout;
mDBITrout: proc external;
end mDBITrout;
/* test if operands match instruction */
searchformatch: proc byte external;
end searchformatch;
$list


74
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/CMSUBR.X86 Normal file
View File

@@ -0,0 +1,74 @@
$nolist
/*
modified 4/13/81 R. Silberstein
modified 9/2/81 R. Silberstein
*/
/* Error numbers: */
dcl
laboutofrange lit '22', /* label out of range */
misssegminfo lit '23'; /* missing segment info in operand */
/* Structures: */
dcl
symbolstruc lit 'struc(
length addr,
stype byte,
sflag byte,
segment addr,
offset addr,
baseindex byte)',
operandstruc lit 'symbolstruc';
/* define bits of SFLAG of structures above */
dcl
type$bit lit '7h', /* bit 0-2 */
segtypebit lit '18h', /* bit 3-4 */
segmbit lit '20h', /* bit 5 */
iregbit lit '40h', /* bit 6 */
bregbit lit '80h', /* bit 7 */
/* left-shift counters */
typecount lit '0',
segtypecount lit '3',
segmcount lit '5',
iregcount lit '6',
bregcount lit '7',
/* define bits of BASEINDEX byte of structures above */
indexregbit lit '01h', /* bit 0 */
baseregbit lit '02h', /* bit 1 */
nooverridebit lit '40h', /* bit 6 */
/* left shift counters */
indexregcount lit '0',
baseregcount lit '1',
noovercount lit '6';
/* Mischellaneous global variables: */
dcl
ABSADDR (4) BYTE EXTERNAL, /* ABSOLUTE ADDRESS FIELD */
cip addr external, /* current instruction pointer */
csegvalue addr external, /* current segment value */
noerror byte external, /* errorflag in codemacro decoding */
firstmacroptr address external, /* pointer at first codemacro */
macroptr address external, /* current pointer within macros */
fullsymbtab byte external, /* full if symboltable is full */
nooper byte external, /* no of instruction operands */
operands(4) operandstruc /* instruction operands,max 4 */
external;
$list


12
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/DEV.LIT Normal file
View File

@@ -0,0 +1,12 @@
$nolist
/* Special file devices if not diskfile : */
dcl
null lit '''Z''-''A''', /* file devices */
printer lit '''Y''-''A''',
console lit '''X''-''A''',
validdisk lit '''P''-''A''';
$list


7
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/DLINE.EXT Normal file
View File

@@ -0,0 +1,7 @@
$nolist
decodeline: proc external;
end decodeline;
$list


24
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/DLINE.X86 Normal file
View File

@@ -0,0 +1,24 @@
$nolist
dcl
pass byte external, /* current pass no, 1,2,3 */
prefix (240) byte external, /* prefix to source line */
prefixptr byte external, /* pointer to prefix buffer */
accumsave(80) byte external,
acclensave byte external,
/* Mischellaneous variables: */
fullsymbtab byte external, /* full if symboltable is full */
currentsymbol symbolstruc /* current scanned symbol */
external,
symbtabadr address external, /* pointer at symbol in table */
codemacroptr address external, /* pointer to found codemacro */
codemacro$flag byte external; /* true if building a codemacro */
$list


132
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/EQUALS.LIT Normal file
View File

@@ -0,0 +1,132 @@
$nolist
/*
modified 7/24/81 R. Silberstein
*/
/* Symbol types : */
dcl
reg lit '0', /* register */
pseudo lit '1', /* pseudo instruction */
code lit '2', /* instruction */
string lit '3', /* character string */
spec lit '4', /* special character */
number lit '5', /* 8 or 16 bit number */
variable lit '6',
lab lit '7', /* label */
operator lit '8', /* operator in expressions */
doubledefined lit '0f9h', /* doubled defined symbol */
neglected lit '0fah', /* neglected symb., never to be def. */
ident lit '0fbh', /* identificator, scanner output */
error lit '0fch', /* error, scanner output */
udefsymb lit '0fdh', /* undefined symbol */
symbol lit '0feh', /* variable,label or undefined symb. */
deletedsymb lit '0ffh'; /* deleted symbol (not used */
/* Symbol description values */
dcl
nil lit '0', /* no specification */
byt lit '1', /* symbol is 8-bit type */
wrd lit '2', /* symbol is 16 bit type */
dwrd lit '4'; /* symbol is 2*16 bit type
or a segment register */
/* Register values : */
dcl
rax lit '0', /* 16 bit registers */
rcx lit '1',
rdx lit '2',
rbx lit '3',
rsp lit '4',
rbp lit '5',
rsi lit '6',
rdi lit '7',
ral lit '0', /* 8 bit registers */
rcl lit '1',
rdl lit '2',
rbl lit '3',
rah lit '4',
rch lit '5',
rdh lit '6',
rbh lit '7',
res lit '0', /* segment registers */
rcs lit '1',
rss lit '2',
rds lit '3';
/* Pseudo instructions: */
dcl
pdb lit '0',
pdd lit '1',
pdw lit '2',
pif lit '3',
prs lit '4',
pend lit '5',
pequ lit '6',
porg lit '7',
pcseg lit '8',
pdbit lit '9',
pdseg lit '10',
pendm lit '11',
peseg lit '12',
prelb lit '13',
prelw lit '14',
psseg lit '15',
pendif lit '16',
pmodrm lit '17',
ptitle lit '18',
psegfix lit '19',
pinclude lit '20',
peject lit '21',
psimform lit '22',
pnosegfix lit '23',
ppagesize lit '24',
pcodemacro lit '25',
ppagewidth lit '26',
plist lit '27',
pnolist lit '28',
prb lit '29', /* added in vers. 2.0 */
prw lit '30',
PIFLIST LIT '31',
PNOIFLIST LIT '32';
/* Symbolic operators */
dcl
oshort lit '0', /* 8-bit value of expression */
oor lit '1', /* logical OR */
oxor lit '2', /* logical XOR */
oand lit '3', /* logical AND */
onot lit '4', /* logical NOT */
oeq lit '5', /* equal */
ogt lit '6', /* greater */
oge lit '7', /* greater or equal */
olt lit '8', /* less */
ole lit '9', /* less or equal */
one lit '10', /* not equal */
omod lit '11', /* arithmetic MOD */
oshl lit '12', /* shift left */
oshr lit '13', /* shift rigth */
optr lit '14', /* take type of 1. op, value of 2. */
ooffset lit '15', /* offset value of operand */
oseg lit '16', /* segment value of operand */
otype lit '17', /* type value of operand */
olength lit '18', /* length attribute of variables */
olast lit '19', /* length - 1 */
leftbracket lit '''[''',
rightbracket lit ''']''';
$list


8
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/ERMOD.EXT Normal file
View File

@@ -0,0 +1,8 @@
$nolist
errmsg: proc(errno) external;
dcl errno byte;
end errmsg;
$list


44
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/ERMOD.LIT Normal file
View File

@@ -0,0 +1,44 @@
$nolist
/*
modified 4/24/81 R. Silberstein
*/
/*
This is all assembler error numbers.
For each error number there is a
corresponding error TEXT. The texts are
defined in the module ERMOD.PLM.
*/
dcl
firstitem lit '0', /* error in first item */
missingpseudo lit '1',
illegalpseudo lit '2',
doubledefvar lit '3', /* doubled defined errors: */
doubledeflab lit '4',
illegalmacro lit '5', /* illegal instruction name */
end$of$line$err lit '6', /* garabage at end of line */
opmismatch lit '7', /* operands mismatch instruction */
illioper lit '8', /* illegal instruction operand */
missinstr lit '9', /* missing instruction */
udefsymbol lit '10', /* undefined element of expression */
pseudooperr lit '11', /* illegal pseudo operand */
nestediferr lit '12', /* nested IF illegal - ignored */
ifparerr lit '13', /* illegal IF operand - IF ignored */
missiferr lit '14', /* no matching "IF" for "ENDIF" */
neglecterr lit '15', /* neglected symbol */
doubledefsymb lit '16', /* doubled defined symbol */
instrerr lit '17', /* instruction not in code segm. */
filesynterr lit '18', /* file name syntax error */
nestedincludeerr lit '19', /* nested INCLUDE not legal */
illexprelem lit '20', /* illegal expression element */
misstypeinfo lit '21', /* missing type info in operands */
laboutofrange lit '22', /* label out of range */
misssegminfo lit '23', /* missing segment info in operand */
codemacroerr lit '24'; /* error in codemacrobuilding */
$list


22
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/EXGLOB.EXT Normal file
View File

@@ -0,0 +1,22 @@
$nolist
dcl
cip addr external, /* current instruction pointer */
csegtype byte external, /* current segment type, code,data */
csegvalue addr external, /* current segment value */
csegspec byte external, /* true if segment value specified */
dspec byte external,
curdseg addr external, /* current data segment value */
token struc( /* actual token scanned */
type byte,
descr byte,
value addr) external, /* token value */
nextch byte external, /* next input character */
acclen byte external, /* accumulator length */
accum(80) byte external, /* actual token scanned */
nooper byte external, /* no of instruction operands */
operands(4) operandstruc /* instruction operands,max 4 */
external;
$list


24
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/EXPR.EXT Normal file
View File

@@ -0,0 +1,24 @@
$nolist
/*
modified 8/19/81 R. Silberstein
*/
operand: proc byte external;
end operand;
NOFORWARDOPER: PROC BYTE EXTERNAL;
END NOFORWARDOPER;
expression: proc(pt) byte external;
dcl pt address;
end expression;
noforwardexpr: proc(pt) byte external;
dcl pt address;
end noforwardexpr;
$list


147
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/EXPR.X86 Normal file
View File

@@ -0,0 +1,147 @@
$nolist
/*
modified 4/24/81 R. Silberstein
*/
/* Symbol types : */
dcl
reg lit '0', /* register */
pseudo lit '1', /* pseudo instruction */
code lit '2', /* instruction */
string lit '3', /* character string */
spec lit '4', /* special character */
number lit '5', /* 8 or 16 bit number */
variable lit '6',
lab lit '7', /* label */
operator lit '8', /* operator in expressions */
doubledefined lit '0f9h', /* doubled defined symbol */
neglected lit '0fah', /* neglected symb.,never to be def. */
ident lit '0fbh', /* identificator, scanner output */
udefsymb lit '0fdh', /* undefined symbol */
symbol lit '0feh', /* variable,label or undef. symb. */
deletedsymb lit '0ffh'; /* deleted symbol (not used */
/* Symbol description values */
dcl
nil lit '0', /* no specification */
byt lit '1', /* symbol is 8-bit type */
wrd lit '2', /* symbol is 16 bit type */
dwrd lit '4'; /* symbol is 2*16 bit type
or a segment register */
/* Register values : */
dcl
rbx lit '3',
rbp lit '5',
rsi lit '6',
rdi lit '7',
res lit '0', /* segment registers */
rcs lit '1',
rss lit '2',
rds lit '3';
/* Symbolic operators */
dcl
oshort lit '0', /* 8-bit value of expression */
oor lit '1', /* logical OR */
oxor lit '2', /* logical XOR */
oand lit '3', /* logical AND */
onot lit '4', /* logical NOT */
oeq lit '5', /* equal */
ogt lit '6', /* greater */
oge lit '7', /* greater or equal */
olt lit '8', /* less */
ole lit '9', /* less or equal */
one lit '10', /* not equal */
omod lit '11', /* arithmetic MOD */
oshl lit '12', /* shift left */
oshr lit '13', /* shift rigth */
optr lit '14', /* take type of 1. op, value of 2. */
ooffset lit '15', /* offset value of operand */
oseg lit '16', /* segment value of operand */
otype lit '17', /* type value of operand */
olength lit '18', /* length attribute of variables */
olast lit '19', /* length - 1 */
leftbracket lit '''[''',
rightbracket lit ''']''';
dcl
operandstruc lit 'struc(
length addr,
stype byte,
sflag byte,
segment addr,
offset addr,
baseindex byte)',
/* define bits of SFLAG of structures above */
type$bit lit '7h', /* bit 0-2 */
segtypebit lit '18h', /* bit 3-4 */
segmbit lit '20h', /* bit 5 */
iregbit lit '40h', /* bit 6 */
bregbit lit '80h', /* bit 7 */
/* left-shift counters */
typecount lit '0',
segtypecount lit '3',
segmcount lit '5',
iregcount lit '6',
bregcount lit '7',
/* define bits of BASEINDEX byte of structures above */
indexregbit lit '7', /* bit 0-2 */
baseregbit lit '38h', /* bit 3-5 */
nooverridebit lit '40h', /* bit 6 */
/* left shift counters */
indexregcount lit '0',
baseregcount lit '3',
noovercount lit '6';
dcl
udefsymbol lit '10'; /* undefined elem. of expression */
newsymbol: proc(lg,stradr,result) byte external;
dcl lg byte,(stradr,result) addr;
end newsymbol;
findsymbol: proc(lg,stradr,result) byte external;
dcl lg byte,(stradr,result) addr;
end findsymbol;
getattributes: proc(symbadr,dest) external;
dcl (symbadr,dest) addr;
end getattributes;
enterattributes: proc(symbadr,source) external;
dcl (symbadr,source) addr;
end enterattributes;
scan: proc external;
end scan;
specialtoken: proc (tok) byte external;
dcl tok byte;
end specialtoken;
bracketexpr: proc (pt) byte external;
dcl pt address;
end bracketexpr;
$list


71
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/FILES.EXT Normal file
View File

@@ -0,0 +1,71 @@
$nolist
/*
modified 3/28/81 R. Silberstein
modified 6/16/81 R. Silberstein
*/
outhexbyte: proc(ch) external;
dcl ch byte;
end outhexbyte;
outprintbyte: proc(ch) external;
dcl ch byte;
end outprintbyte;
outsymbolbyte: proc(ch) external;
dcl ch byte;
end outsymbolbyte;
insourcebyte: proc byte external;
end insourcebyte;
inincludebyte: proc byte external;
end inincludebyte;
opensource: proc external;
end opensource;
openinclude: proc external;
end openinclude;
openhex: proc external;
end openhex;
openprint: proc external;
end openprint;
opensymbol: proc external;
end opensymbol;
close$source: proc external;
end close$source;
rewindsource: proc external;
end rewindsource;
close$include: proc external;
end close$include;
closehex: proc external;
end closehex;
closeprint: proc external;
end closeprint;
closesymbol: proc external;
end closesymbol;
i$file$setup: proc(dev,filnam,filtyp) external;
dcl dev byte,(filnam,filtyp) addr;
end i$file$setup;
filesetup: proc byte external;
end filesetup;
$list


114
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/GLOBAL.EXT Normal file
View File

@@ -0,0 +1,114 @@
$nolist
/*
modified 3/28/81 R. Silberstein
modified 4/16/81 R. Silberstein
modified 7/24/81 R. Silberstein
modified 9/2/81 R. Silberstein
*/
dcl
pass byte external, /* current pass no, 1,2,3 */
/* address counters */
cip addr external, /* current instruction pointer */
csegtype byte external, /* current segment type, code,data,
stack or extra data */
csegvalue addr external, /* current segment value */
csegspec byte external, /* true if segment value specified */
escip addr external, /* current ES instruction pointer */
cscip addr external, /* current CS instruction pointer */
sscip addr external, /* current SS instruction pointer */
dscip addr external, /* current DS instruction pointer */
curcseg addr external, /* current code segment value */
curdseg addr external, /* current data segment value */
cursseg addr external, /* current stack segment value */
cureseg addr external, /* current extra segment value */
cspec byte external, /* true if code segm. value given */
dspec byte external, /* true if data segm. value given */
sspec byte external, /* true if stack segment given */
espec byte external, /* true if extra segment given */
/* print output parameters */
print$on byte external, /* on/off flag */
printswitchoff byte external, /* set/reset by NOLIST/LIST */
IFLIST BYTE EXTERNAL, /* SET/RESET BY IFLIST/NOIFLIST */
maxcol byte external, /* pagewidth */
sourcename (12) byte external, /* source file name */
savesource (12) byte external, /* source file during INLUDE file */
printdevice byte external, /* printfile device */
SYMBOLDEVICE BYTE EXTERNAL, /* SYMBOL FILE DEVICE */
title (30) byte external, /* user specified program title */
pagesize byte external, /* page size */
simform byte external, /* true if formfeed simulation */
sourcebuf (80) byte external, /* source input to be printed */
sourceptr byte external, /* source buffer pointer */
prefix (240) byte external, /* prefix to source line */
prefixptr byte external, /* pointer to prefix buffer */
ABSADDR (4) BYTE EXTERNAL, /* ABSOLUTE ADDRESS FIELD */
/* io error status */
errors addr external, /* counts no of errors */
/* scanner variables: */
token struc( /* actual token scanned */
type byte, /* token type, legal values :
reg - register
pseudo - pseudo code
string - text string
spec - special character
number - number
operator - aritmetic operator
ident - identifier */
descr byte, /* token description, legal values:
nil - no specification
byte - 8 bit type
word - 16 bit type
dword - 32 bit type */
value addr) external, /* token value */
nextch byte external, /* next input character */
acclen byte external, /* accumulator length */
accum(80) byte external, /* actual token scanned */
accumsave(80) byte external,
acclensave byte external,
eofset byte external, /* true if end-of-file found */
/* Mischellaneous variables: */
intel$hex$on byte external, /* true if INTEL hex format */
noerror byte external, /* codemacro decoding errorflag */
errorprinted byte external, /* true if an error is printed */
firstmacroptr address external, /* pointer at first codemacro */
macroptr address external, /* current pointer within macros */
fullsymbtab byte external, /* full if symboltable is full */
include$on byte external, /* true if INCLUDEfile input */
IFLEVEL BYTE EXTERNAL, /* IF-ENDIF NESTING LEVEL */
currentsymbol symbolstruc /* current scanned symbol */
external,
symbtabadr address external, /* pointer at symbol in table */
nooper byte external, /* no of instruction operands */
operands(4) operandstruc /* instruction operands,max 4 */
external,
codemacroptr address external, /* pointer to found codemacro */
help(5) byte external, /* ascii number scratch area */
i byte external, /* scratch variable */
default$drive byte external, /* default disk drive */
include$default byte external, /* default drive for include file */
codemacro$flag byte external; /* true if building a codemacro */
globalinit: procedure external; /* initiate some globals */
end globalinit;
$list


7
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/INSTR.EXT Normal file
View File

@@ -0,0 +1,7 @@
$nolist
instruction: proc external;
end instruction;
$list


17
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/INSTR.X86 Normal file
View File

@@ -0,0 +1,17 @@
$nolist
dcl
acclen byte external, /* accumulator length */
accum(80) byte external, /* actual token scanned */
/* Mischellaneous variables: */
noerror byte external, /* errorflag in codemacro decoding */
firstmacroptr address external, /* pointer at first codemacro */
macroptr address external, /* current pointer within macros */
nooper byte external, /* no of instruction operands */
operands(4) operandstruc /* instruction operands,max 4 */
external,
codemacroptr address external; /* pointer to found codemacro */
$list

113
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D11/IO.EXT Normal file
View File

@@ -0,0 +1,113 @@
$nolist
/* Template for all BDOS calls */
/*
modified 3/26/81 R. Silberstein
modified 9/14/81 R. Silberstein
*/
mon1: procedure(func,info) external;
declare func byte,
info address;
end mon1;
mon2: procedure(func,info) byte external;
declare func byte,
info address;
end mon2;
declare fcb(1) byte external;
declare fcb16(1) byte external;
declare tbuff(1) byte external;
declare endbuf address external;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
system$reset:
procedure external;
end system$reset;
read$console:
procedure byte external;
end read$console;
write$console:
procedure (char) external;
declare char byte;
end write$console;
write$list:
procedure (char) external;
declare char byte;
end write$list;
constat:
procedure byte external;
end constat;
VERSION: PROCEDURE ADDRESS EXTERNAL;
END VERSION;
select$disk:
procedure (disk$number) external;
declare disk$number byte;
end select$disk;
open$file:
procedure (fcb$address) byte external;
declare fcb$address address;
end open$file;
OPEN$RO$FILE: PROCEDURE (FCB$ADDRESS) BYTE EXTERNAL;
DECLARE FCB$ADDRESS ADDRESS;
END OPEN$RO$FILE;
close$file:
procedure (fcb$address) byte external;
declare fcb$address address;
end close$file;
delete$file:
procedure (fcb$address) external;
declare fcb$address address;
end delete$file;
read$record:
procedure (fcb$address) byte external;
declare fcb$address address;
end read$record;
write$record:
procedure (fcb$address) byte external;
declare fcb$address address;
end write$record;
create$file:
procedure (fcb$address) byte external;
declare fcb$address address;
end create$file;
interrogate$disk:
procedure byte external;
end interrogate$disk;
set$DMA$address:
procedure (DMA$address) external;
declare DMA$address address;
end set$DMA$address;
crlf: procedure external;
end crlf;
$list


Some files were not shown because too many files have changed in this diff Show More