Digital Research
This commit is contained in:
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions

View File

@@ -0,0 +1,218 @@
title 'MP/M II V2.0 Abort Resident System Process'
name 'abort'
cseg
;abort:
;do;
;$include (copyrt.lit)
;/*
; Copyright (C) 1979, 1980, 1981
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
;
; Revised:
; 14 Sept 81 by Thomas Rolander
;*/
;$include (common.lit)
;$nolist
;$include (proces.lit)
;$nolist
;$include (queue.lit)
;$nolist
;$include (mon2.lit)
;$nolist
;$include (datapg.ext)
;$nolist
;$include (mon2.ext)
;$nolist
;$include (bdos.ext)
;$nolist
; declare rlrpd based rlr process$descriptor;
;/*
; Abort Process Data Segment
;*/
; declare os address;
os: dw $-$
; declare abort$pd process$descriptor
; initial (0,rtr$status,20,.abort$entrypt,
; 'ABORT ',' '+80h,0,0ffh,0);
abortpd:
dw 0 ; pl
db 0 ; status
db 20 ; priority
dw abortentrypt ; stkptr
db 'ABORT ',' '+80h ; name
db $-$ ; console
db 0ffh ; memseg (system)
dw $-$ ; b
dw $-$ ; thread
dw $-$ ; disk set DMA
db $-$ ; disk select / user code
dw $-$ ; dcnt
db $-$ ; searchl
dw $-$ ; searcha
dw $-$ ; drvact
ds 20 ; registers
ds 2 ; scratch
apcb:
abtpd: dw 0
abortmsg:
param:
dskslct: ds 1
console: ds 1
pname: ds 8
abtcns: ds 1
ds 1 ;filler for 12 byte message
; declare abort$stk (15) address
; initial (restarts,.abort);
abortstk:
dw 0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h
abortentrypt:
dw abort
; declare abort$lqcb structure (
; lqueue,
; buf (14) byte )
; initial (0,'ABORT ',12,1);
abortlqcb:
dw $-$ ; ql
db 'ABORT ' ; name
dw 12 ; msglen
dw 1 ; nmbmsgs
dw $-$ ; dqph
dw $-$ ; nqph
dw $-$ ; mh
dw $-$ ; mt
dw $-$ ; bh
ds 2 ; link
ds 12 ; buf (12) byte
; declare abort$uqcb userqcbhead
; initial (.abort$lqcb,.dskslct);
abortuqcb:
dw abortlqcb ; pointer
dw abortmsg ; msgadr
abortfail:
db 'Abort failed.'
db '$'
;/*
; abort:
; The purpose of the abort process is to abort
; the specified process.
; Entry Conditions:
; None
; Exit Conditions:
; None
;*/
; abort:
abort:
; procedure;
; declare i byte;
; call mon1 (make$queue,.abort$lqcb);
LXI D,ABORTLQCB
MVI C,86H
; do forever;
@4:
CALL MON1
; call mon1 (read$queue,.abort$uqcb);
LXI D,ABORTUQCB
MVI C,89H
CALL MON1
; abortpd.console = console;
LDA CONSOLE
sta abortpd+0eh
push psw ;save abtcns
lxi h,pname
mvi c,10
namefill:
mov a,m
ora a
jz spacefill
cpi ' '
jz cnspcfd
inx h
dcr c
jnz namefill
jmp @7
cnspcfd:
inx h
mov a,m
pop d
push psw
dcx h
spacefill:
mvi m,' '
inx h
dcr c
jnz spacefill
@7:
pop psw
ani 0fh
sta abtcns
; /* parameters to MON2 abort process are terminate
; system or non-sytem process & release memory segment */
; apcb.param = 00ffh;
lxi h,00ffh
shld param
; if mon2 (abort$process,.apcb) = 255 then
LXI D,apcb
MVI C,9dH
CALL MON2
INR L
; do;
; call mon1 (9,.('Abort failed.','$'));
mvi c,9
LXI d,abortfail
cz mon1
; end;
@9:
; call mon1 (detlst,0);
mvi c,9fh
call mon1
; call mon1 (detach,0);
MVI C,93H
; end; /* forever */
JMP @4
; end abort;
; mon1:
mon1:
; procedure (func,info) external;
; declare func byte;
; declare info address;
; end mon1;
; mon2:
mon2:
; procedure (func,info) byte external;
; declare func byte;
; declare info address;
; end mon2;
lhld os
pchl
;end abort;
END


View File

@@ -0,0 +1,19 @@
stat abort.rsp $$r/w
ren abort.gen=abort.rsp
pip a:=e:abort.asm
rmac abort
xref abort
vax abort.xrf $$stan
link abort[or]
pip e:=a:abort.rsp
pip b:=a:abort.rsp
era abort.rsp
era abort.asm
era abort.sym
era abort.prn
era abort.xrf
era abort.rel
ren abort.rsp=abort.gen
stat abort.rsp $$r/o
;end abort submit


View File

@@ -0,0 +1,66 @@
era brspbi.asm
pip a:=brspbi.asm[g4]
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
;vax brspbi.lst $$stan
era $1rsp.plm
pip a:=$1rsp.plm[g4]
seteof $1rsp.plm
era $1brs.plm
pip a:=$1brs.plm[g4]
seteof $1brs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1rsp.plm pagewidth(80) debug
era $1rsp.plm
link $1rsp.obj to $1rsp.mod
era $1rsp.obj
locate $1rsp.mod to $1rsp1 code(0000H) stacksize(0)
locate $1rsp.mod to $1rsp2 code(0100H) stacksize(0)
era $1rsp.mod
objhex $1rsp1 to $1rsp1.hex
objhex $1rsp2 to $1rsp2.hex
era $1rsp2
cpm
objcpm $1rsp1
era $1rsp1
era $1rsp1.com
pip $1rsp.hex=$1rsp1.hex,$1rsp2.hex
genmod $1rsp.hex $1rsp.rsp
era $1rsp*.hex
;vax $1rsp.lst $$stan
;vax $1rsp1.sym $$stan
;vax $1rsp1.lin $$stan
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1brs.plm pagewidth(80) debug
era $1brs.plm
link $1brs.obj,brspbi,plm80.lib to $1brs.mod
era $1brs.obj
locate $1brs.mod to $1brs1 code(0000H) stacksize(0)
locate $1brs.mod to $1brs2 code(0100H) stacksize(0)
era $1brs.mod
objhex $1brs1 to $1brs1.hex
objhex $1brs2 to $1brs2.hex
era $1brs2
cpm
objcpm $1brs1
era $1brs1
era $1brs1.com
pip $1brs.hex=$1brs1.hex,$1brs2.hex
genmod $1brs.hex $1brs.brs
era $1brs*.hex
;vax $1brs.lst $$stan
;vax $1brs1.sym $$stan
;vax $1brs1.lin $$stan


View File

@@ -0,0 +1,57 @@
era $1rsp.plm
pip a:=$1rsp.plm[g4]
seteof $1rsp.plm
era $1brs.plm
pip a:=$1brs.plm[g4]
seteof $1brs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1rsp.plm pagewidth(80) debug
era $1rsp.plm
link $1rsp.obj to $1rsp.mod
era $1rsp.obj
locate $1rsp.mod to $1rsp1 code(0000H) stacksize(0)
locate $1rsp.mod to $1rsp2 code(0100H) stacksize(0)
era $1rsp.mod
objhex $1rsp1 to $1rsp1.hex
objhex $1rsp2 to $1rsp2.hex
era $1rsp2
cpm
objcpm $1rsp1
era $1rsp1
era $1rsp1.com
pip $1rsp.hex=$1rsp1.hex,$1rsp2.hex
genmod $1rsp.hex $1rsp.rsp
era $1rsp*.hex
;vax $1rsp.lst $$stan
;vax $1rsp1.sym $$stan
;vax $1rsp1.lin $$stan
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1brs.plm pagewidth(80) debug
era $1brs.plm
link $1brs.obj,brspbi,plm80.lib to $1brs.mod
era $1brs.obj
locate $1brs.mod to $1brs1 code(0000H) stacksize(0)
locate $1brs.mod to $1brs2 code(0100H) stacksize(0)
era $1brs.mod
objhex $1brs1 to $1brs1.hex
objhex $1brs2 to $1brs2.hex
era $1brs2
cpm
objcpm $1brs1
era $1brs1
era $1brs1.com
pip $1brs.hex=$1brs1.hex,$1brs2.hex
genmod $1brs.hex $1brs.brs
era $1brs*.hex
;vax $1brs.lst $$stan
;vax $1brs1.sym $$stan
;vax $1brs1.lin $$stan


View File

@@ -0,0 +1,29 @@
$title ('Banked Resident System Process BDOS Interface')
name brspbi
;
;/*
; Copyright (C) 1979,1980,1981
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
;
; Revised:
; 14 Sept 81 by Thomas Rolander
;*/
cseg
;
extrn os
;
public mon1,mon2,mon2a
mon1:
mon2:
mon2a:
lhld os
mov a,m
inx h
mov h,m
mov l,a
pchl
;
end


View File

@@ -0,0 +1,69 @@
era $2.plm
pip a:=$2.plm[g7]
seteof $2.plm
era brspbi.asm
pip a:=brspbi.asm[g7]
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
vax brspbi.lst $$stanp
era $1rsp.plm
pip a:=$1rsp.plm[g7]
seteof $1rsp.plm
era $1brs.plm
pip a:=$1brs.plm[g7]
seteof $1brs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1rsp.plm pagewidth(80) debug
era $1rsp.plm
link $1rsp.obj to $1rsp.mod
era $1rsp.obj
locate $1rsp.mod to $1rsp1 code(0000H) stacksize(0)
locate $1rsp.mod to $1rsp2 code(0100H) stacksize(0)
era $1rsp.mod
objhex $1rsp1 to $1rsp1.hex
objhex $1rsp2 to $1rsp2.hex
era $1rsp2
cpm
objcpm $1rsp1
era $1rsp1
era $1rsp1.com
pip $1rsp.hex=$1rsp1.hex,$1rsp2.hex
genmod $1rsp.hex $1rsp.rsp
era $1rsp*.hex
vax $1rsp.lst $$stanp
vax $1rsp1.sym $$stanp
vax $1rsp1.lin $$stanp
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 $1brs.plm pagewidth(80) debug
era $1brs.plm
link $1brs.obj,brspbi,plm80.lib to $1brs.mod
era $1brs.obj
locate $1brs.mod to $1brs1 code(0000H) stacksize(0)
locate $1brs.mod to $1brs2 code(0100H) stacksize(0)
era $1brs.mod
objhex $1brs1 to $1brs1.hex
objhex $1brs2 to $1brs2.hex
era $1brs2
cpm
objcpm $1brs1
era $1brs1
era $1brs1.com
pip $1brs.hex=$1brs1.hex,$1brs2.hex
genmod $1brs.hex $1brs.brs
era $1brs*.hex
vax $1brs.lst $$stanp
vax $1brs1.sym $$stanp
vax $1brs1.lin $$stanp


View File

@@ -0,0 +1,74 @@
era mscmn.plm
pip a:=e:mscmn.plm
seteof mscmn.plm
era brspbi.asm
pip a:=e:brspbi.asm
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
vax brspbi.lst $$stan
era msrsp.plm
pip a:=e:msrsp.plm
seteof msrsp.plm
era msbrs.plm
pip a:=e:msbrs.plm
seteof msbrs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 msrsp.plm pagewidth(80) debug
era msrsp.plm
link msrsp.obj to msrsp.mod
era msrsp.obj
locate msrsp.mod to msrsp1 code(0000H) stacksize(0)
locate msrsp.mod to msrsp2 code(0100H) stacksize(0)
era msrsp.mod
objhex msrsp1 to msrsp1.hex
objhex msrsp2 to msrsp2.hex
era msrsp2
cpm
objcpm msrsp1
era msrsp1
era msrsp1.com
pip msrsp.hex=msrsp1.hex,msrsp2.hex
genmod msrsp.hex msrsp.rsp
pip e:mpmstat.rsp=a:msrsp.rsp
pip b:mpmstat.rsp=a:msrsp.rsp
vax msrsp.lst $$stan
vax msrsp1.sym $$stan
vax msrsp1.lin $$stan
era msrsp*.*
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 msbrs.plm pagewidth(80) debug
era msbrs.plm
link msbrs.obj,brspbi,plm80.lib to msbrs.mod
era msbrs.obj
locate msbrs.mod to msbrs1 code(0000H) stacksize(0)
locate msbrs.mod to msbrs2 code(0100H) stacksize(0)
era msbrs.mod
objhex msbrs1 to msbrs1.hex
objhex msbrs2 to msbrs2.hex
era msbrs2
cpm
objcpm msbrs1
era msbrs1
era msbrs1.com
pip msbrs.hex=msbrs1.hex,msbrs2.hex
genmod msbrs.hex msbrs.brs
pip e:mpmstat.brs=a:msbrs.brs
pip b:mpmstat.brs=a:msbrs.brs
vax msbrs.lst $$stan
vax msbrs1.sym $$stan
vax msbrs1.lin $$stan
era msbrs*.*
;end mpmstat submit


View File

@@ -0,0 +1,74 @@
era mscmn.plm
pip a:=e:mscmn.plm
seteof mscmn.plm
era brspbi.*
pip a:=e:brspbi.asm
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
vax brspbi.lst $$stan
era msrsp.plm
pip a:=e:msrsp.plm
seteof msrsp.plm
era msbrs.plm
pip a:=e:msbrs.plm
seteof msbrs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 msrsp.plm pagewidth(80) debug
era msrsp.plm
link msrsp.obj to msrsp.mod
era msrsp.obj
locate msrsp.mod to msrsp1 code(0000H) stacksize(0)
locate msrsp.mod to msrsp2 code(0100H) stacksize(0)
era msrsp.mod
objhex msrsp1 to msrsp1.hex
objhex msrsp2 to msrsp2.hex
era msrsp2
cpm
objcpm msrsp1
era msrsp1
era msrsp1.com
pip msrsp.hex=msrsp1.hex,msrsp2.hex
genmod msrsp.hex msrsp.rsp
pip e:mpmstat.rsp=a:msrsp.rsp
pip b:mpmstat.rsp=a:msrsp.rsp
vax msrsp.lst $$stan
vax msrsp1.sym $$stan
vax msrsp1.lin $$stan
era msrsp*.*
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 msbrs.plm pagewidth(80) debug
era msbrs.plm
link msbrs.obj,brspbi,plm80.lib to msbrs.mod
era msbrs.obj
locate msbrs.mod to msbrs1 code(0000H) stacksize(0)
locate msbrs.mod to msbrs2 code(0100H) stacksize(0)
era msbrs.mod
objhex msbrs1 to msbrs1.hex
objhex msbrs2 to msbrs2.hex
era msbrs2
cpm
objcpm msbrs1
era msbrs1
era msbrs1.com
pip msbrs.hex=msbrs1.hex,msbrs2.hex
genmod msbrs.hex msbrs.brs
pip e:mpmstat.brs=a:msbrs.brs
pip b:mpmstat.brs=a:msbrs.brs
vax msbrs.lst $$stan
vax msbrs1.sym $$stan
vax msbrs1.lin $$stan
era msbrs*.*
;end mpmstat submit


View File

@@ -0,0 +1,104 @@
$title('MP/M II V2.0 Status Process - Banked Portion')
status:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (dpgos.lit)
$include (proces.lit)
$include (queue.lit)
$include (memmgr.lit)
$include (xdos.lit)
declare restarts literally
'0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H';
/*
Status Process Data Segment
*/
declare os address public
data (0);
declare status$stack$pointer address
data (.status$stk+38);
declare nrs$name (8) byte data (
'Mpmstat ');
declare status$pd$adr address;
declare status$pd based status$pd$adr process$descriptor;
declare status$stk (20) address
initial (restarts,.status);
declare status$cqcb$adr address;
declare status$cqcb based status$cqcb$adr structure (
cqueue,
buf (2) byte );
declare status$uqcb userqcbhead public
initial (0,.field);
declare field (2) byte;
declare console byte at (.field(1));
$include (mscmn.plm)
declare last$dseg$byte byte
initial (0);
/*
status:
The purpose of the status process is to display
the status of the MP/M II V2.0 operating system.
Entry Conditions:
None
Exit Conditions:
None
*/
status:
procedure public;
declare ret byte;
status$pd$adr = os + 2;
status$cqcb$adr = status$pd$adr + 52;
status$uqcb.pointer = .status$cqcb;
ret = xdos (make$queue,.status$cqcb);
call setup;
do forever;
ret = xdos (read$queue,.status$uqcb);
rlrpd.console = console;
call crlf;
call crlf;
call display$text (0,
.('****** MP/M II V2.0 Status Display ******','$'));
call display$config;
call display$ready;
call display$DQ;
call display$NQ;
call display$delay;
call display$poll;
call display$flag$wait;
call display$flag$set;
call display$queues;
call display$consoles;
call display$printers;
call display$mem$seg;
ret = xdos (detach,0);
ret = xdos (detach$list,0);
end; /* forever */
end status;
end status;


View File

@@ -0,0 +1,500 @@
/*
Common Literals
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
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;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
co:
procedure (char);
declare char byte;
call mon1 (2,char);
end co;
print$buffer:
procedure (bufferadr);
declare bufferadr address;
call mon1 (9,bufferadr);
end print$buffer;
read$buffer:
procedure (bufferadr);
declare bufferadr address;
call mon1 (10,bufferadr);
end read$buffer;
crlf:
procedure;
call co (0DH);
call co (0AH);
end crlf;
declare xdos literally 'mon2a';
declare datapgadr address;
declare datapg based datapgadr address;
declare param$adr address;
declare param based param$adr structure (
mem$top byte,
nmbcns byte,
breakpoint$restart byte,
add$sys$stack byte,
bank$switching byte,
Z80 byte,
banked$BDOS byte );
declare rlradr address;
declare rlr based rlradr address;
declare rlrcont address;
declare rlrpd based rlrcont process$descriptor;
declare dlradr address;
declare dlr based dlradr address;
declare drladr address;
declare drl based drladr address;
declare plradr address;
declare plr based plradr address;
declare slradr address;
declare slr based slradr address;
declare qlradr address;
declare qlr based qlradr address;
declare nmb$cns$adr address;
declare nmb$consoles based nmb$cns$adr byte;
declare cns$att$adr address;
declare console$attached based cns$att$adr (1) address;
declare cns$que$adr address;
declare console$queue based cns$que$adr (1) address;
declare nmb$lst$adr address;
declare nmb$printers based nmb$lst$adr byte;
declare lst$att$adr address;
declare list$attached based lst$att$adr (1) address;
declare lst$que$adr address;
declare list$queue based lst$que$adr (1) address;
declare nmbflags$adr address;
declare nmbflags based nmbflags$adr byte;
declare sys$flg$adr address;
declare sys$flag based sys$flg$adr (1) address;
declare nmb$seg$adr address;
declare nmb$segs based nmb$seg$adr byte;
declare mem$seg$tbl$adr address;
declare mem$seg$tbl based mem$seg$tbl$adr (1) memory$descriptor;
declare pdtbl$adr address;
declare pdtbl based pdtbl$adr (1) process$descriptor;
declare hex$digit (*) byte data ('0123456789ABCDEF');
declare queue$adr address;
declare queue based queue$adr structure (
cqueue,
owner$adr address );
display$hex$byte:
procedure (value);
declare value byte;
call co (hex$digit(shr(value,4)));
call co (hex$digit(value mod 16));
end display$hex$byte;
display$text:
procedure (count,text$adr);
declare count byte;
declare text$adr address;
declare char based text$adr byte;
declare i byte;
if count+char = 0 then return;
if count = 0 then
do;
call print$buffer (text$adr);
end;
else
do i = 1 to count;
call co (char and 7fh);
text$adr = text$adr + 1;
end;
end display$text;
display$links:
procedure (count,title$adr,root$adr);
declare count byte;
declare (title$adr,root$adr) address;
declare char based title$adr byte;
declare pd based root$adr process$descriptor;
declare i byte;
declare link$list (64) address;
declare (n,k) byte;
if count+char <> 0 then call crlf;
call display$text (count,title$adr);
if count+char = 0
then i = 0;
else i = 7;
n = -1;
disable; /* critical section required to obtain list */
do while (root$adr <> 0) and (n <> 63) and (high(root$adr) <> 0ffh);
link$list(n:=n+1) = root$adr;
root$adr = pd.pl;
end;
call mon1 (dispatch,0); /* enable interrupts by dispatching */
if n = -1 then return;
do k = 0 to n;
root$adr = link$list(k);
i = i + 1;
if i >= 8 then
do;
call crlf;
call co (' ');
i = 1;
end;
call co (' ');
call display$text (8,.pd.name);
if pd.memseg <> 0ffh then
do;
call co ('[');
call co (hex$digit(pd.console and 0fh));
call co (']');
end;
end;
end display$links;
display$config:
procedure;
call display$text (0,
.(0dh,0ah,0dh,0ah,'Top of memory = ','$'));
call display$hex$byte (param.mem$top);
call display$text (0,
.('FFH',0dh,0ah,'Number of consoles = ','$'));
call display$hex$byte (nmb$consoles);
call display$text (0,
.(0dh,0ah,'Debugger breakpoint restart # = ','$'));
call display$hex$byte (param.breakpoint$restart);
if param.add$sys$stack then
do;
call display$text (0,
.(0dh,0ah,'Stack is swapped on BDOS calls','$'));
end;
if param.bank$switching then
do;
call display$text (0,
.(0dh,0ah,'Memory is bank switched','$'));
if param.banked$BDOS then
do;
call display$text (0,
.(0dh,0ah,'BDOS disk file management is bank switched','$'));
end;
end;
if param.Z80 then
do;
call display$text (0,
.(0dh,0ah,'Z80 complementary registers managed by dispatcher','$'));
end;
call crlf;
end display$config;
display$ready:
procedure;
call display$links (0,
.('Ready Process(es):','$'),rlr);
end display$ready;
display$DQ:
procedure;
call crlf;
call display$text (0,
.('Process(es) DQing:','$'));
queue$adr = qlr;
do while queue$adr <> 0;
if queue.dqph <> 0 then
do;
call display$text (4,.(0DH,0AH,' ['));
call display$text (8,.queue.name);
call co (']');
call display$links (0,.(0),queue.dqph);
end;
queue$adr = queue.ql;
end;
end display$DQ;
display$NQ:
procedure;
call crlf;
call display$text (0,
.('Process(es) NQing:','$'));
queue$adr = qlr;
do while queue$adr <> 0;
if queue.nqph <> 0 then
do;
call display$text (4,.(0DH,0AH,' ['));
call display$text (8,.queue.name);
call co (']');
call display$links (0,.(0),queue.nqph);
end;
queue$adr = queue.ql;
end;
end display$NQ;
display$delay:
procedure;
call display$links (0,
.('Delayed Process(es):','$'),dlr);
end display$delay;
display$poll:
procedure;
call display$links (0,
.('Polling Process(es):','$'),plr);
end display$poll;
display$flag$wait:
procedure;
declare i byte;
call crlf;
call display$text (0,
.('Process(es) Flag Waiting:','$'));
do i = 0 to nmbflags-1;
if sys$flag(i) < 0FFFEH then
do;
call crlf;
call co (' ');
call co (' ');
call display$hex$byte (i);
call display$text (3,.(' - '));
call display$links (0,.(0),sys$flag(i));
end;
end;
end display$flag$wait;
display$flag$set:
procedure;
declare i byte;
call crlf;
call display$text (0,
.('Flag(s) Set:','$'));
do i = 0 to nmbflags-1;
if sys$flag(i) = 0FFFEH then
do;
call crlf;
call co (' ');
call co (' ');
call display$hex$byte (i);
end;
end;
end display$flag$set;
display$queues:
procedure;
declare i byte;
queue$adr = qlr;
call crlf;
call display$text (0,
.('Queue(s):','$'));
i = 7;
do while queue$adr <> 0;
i = i + 1;
if i >= 8 then
do;
call crlf;
call co (' ');
i = 1;
end;
call co (' ');
call display$text (8,.queue.name);
if (queue.name(0) = 'M') and
(queue.name(1) = 'X') and
(queue.msglen = 0 ) and
(queue.nmbmsgs = 1 ) and
(queue.msgcnt = 0 ) then
do;
call co ('[');
call display$text (8,queue.owner$adr+6);
call co (']');
i = i + 1;
end;
queue$adr = queue.ql;
end;
call crlf;
end display$queues;
display$consoles:
procedure;
declare i byte;
declare name$offset literally '6';
call display$text (0,
.('Process(es) Attached to Consoles:','$'));
if nmb$consoles <> 0 then
do i = 0 to nmb$consoles-1;
call display$text (5,.(0dh,0ah,' ['));
call co (hex$digit(i));
call display$text (4,.('] - '));
if console$attached(i) = 0
then call display$text (0,
.('Unattached','$'));
else call display$text (8,
console$attached(i) + name$offset);
end;
call display$text (0,.(0dh,0ah,
'Process(es) Waiting for Consoles:','$'));
if nmb$consoles <> 0 then
do i = 0 to nmb$consoles-1;
if console$queue(i) <> 0 then
do;
call display$text (5,.(0dh,0ah,' ['));
call co (hex$digit(i));
call display$text (4,.('] - '));
call display$links (0,.(0),console$queue(i));
end;
end;
end display$consoles;
display$printers:
procedure;
declare i byte;
declare name$offset literally '6';
call display$text (0,
.(0dh,0ah,'Process(es) Attached to Printers:','$'));
if nmb$printers <> 0 then
do i = 0 to nmb$printers-1;
call display$text (5,.(0dh,0ah,' ['));
call co (hex$digit(i));
call display$text (4,.('] - '));
if list$attached(i) = 0
then call display$text (0,
.('Unattached','$'));
else call display$text (8,
list$attached(i) + name$offset);
end;
call display$text (0,.(0dh,0ah,
'Process(es) Waiting for Printers:','$'));
if nmb$printers <> 0 then
do i = 0 to nmb$printers-1;
if list$queue(i) <> 0 then
do;
call display$text (5,.(0dh,0ah,' ['));
call co (hex$digit(i));
call display$text (4,.('] - '));
call display$links (0,.(0),list$queue(i));
end;
end;
end display$printers;
display$mem$seg:
procedure;
declare i byte;
call display$text (0,.(0dh,0ah,
'Memory Allocation:','$'));
do i = 0 to nmbsegs-1;
call display$text (0,
.(0dh,0ah,' Base = ','$'));
call display$hex$byte (memsegtbl(i).base);
call display$text (0,
.('00H Size = ','$'));
call display$hex$byte (memsegtbl(i).size);
call display$text (0,.('00','$'));
if param.bank$switching then
do;
call display$text (0,
.('H Bank = ','$'));
call display$hex$byte (memsegtbl(i).bank);
end;
if (memsegtbl(i).attrib and allocated) = 0 then
do;
call display$text (0,
.('H * Free *','$'));
end;
else
do;
if memsegtbl(i).attrib = 0ffh then
do;
call display$text (0,
.('H * Reserved *','$'));
end;
else
do;
call display$text (0,
.('H Allocated to ','$'));
call display$text (8,.pdtbl(i).name);
call co ('[');
call co (hex$digit(pdtbl(i).console and 0fh));
call co (']');
end;
end;
end;
end display$mem$seg;
setup:
procedure;
datapgadr = (param$adr:=xdos (system$data$adr,0)) + 252;
datapgadr = datapg;
rlradr = datapgadr + osrlr;
rlrcont = rlr;
dlradr = datapgadr + osdlr;
drladr = datapgadr + osdrl;
plradr = datapgadr + osplr;
slradr = datapgadr + osslr;
qlradr = datapgadr + osqlr;
nmb$cns$adr = datapgadr + osnmbcns;
cns$att$adr = datapgadr + oscnsatt;
cns$que$adr = datapgadr + oscnsque;
nmb$lst$adr = datapgadr + osnmblst;
lst$att$adr = datapgadr + oslstatt;
lst$que$adr = datapgadr + oslstque;
nmbflags$adr = datapgadr + osnmbflags;
sys$flg$adr = datapgadr + ossysfla;
nmb$seg$adr = datapgadr + osnmbsegs;
mem$seg$tbl$adr = datapgadr + osmsegtbl;
pdtbl$adr = datapgadr + ospdtbl;
end setup;


View File

@@ -0,0 +1,30 @@
$title('MP/M II V2.0 Status Process - Resident Portion')
status:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (proces.lit)
$include (queue.lit)
/*
Status Process Data Segment
*/
declare bdos$entry address
data (0);
declare status$pd process$descriptor public
data (0,rtr$status,190,0,
'MP',0cdh /* ('M'+80h) */,'STAT',
0a0h /* ' '+80h */,0,0,0);
declare status$cqcb structure (
cqueue,
buf (2) byte )
initial (0,'MPMSTAT ',2,1);
end status;


View File

@@ -0,0 +1,188 @@
$title('MP/M II V2.0 Scheduler Process - Banked Portion')
sched:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (proces.lit)
$include (queue.lit)
$include (xdos.lit)
/*
Common Literals
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare restarts literally
'0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H';
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;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
declare xdos literally 'mon2';
declare xdosa literally 'mon2a';
/*
Sched Process Data Segment
*/
declare os address public
data (0);
declare sched$stack$pointer address
data (.sched$stk+38);
declare nrs$name (8) byte data (
'Sched ');
declare sched$pd$adr address;
declare sched$pd based sched$pd$adr process$descriptor;
declare sched$stk (20) address
initial (restarts,.sched);
declare sched$lqcb$adr address;
declare sched$lqcb based sched$lqcb$adr structure (
lqueue,
buf (71) byte);
declare sched$uqcb userqcbhead
initial (0,.new$entry);
declare cli$uqcb userqcb
initial (0,0,'CliQ ');
declare ret address;
declare (char,index,tindx) byte;
declare scheduling boolean;
declare temp address;
declare tod structure (
date address,
hrs byte,
min byte,
sec byte );
declare sched$item literally 'structure (
date address,
hrs byte,
min byte,
cli$command (65) byte )';
declare new$entry sched$item;
declare sched$table (4) sched$item;
declare assign$cli$pb (10) byte initial (
0,'cli ',0);
room$in$table:
procedure boolean;
do tindx = 0 to 3;
if sched$table(tindx).date = 0
then return true;
end;
return false;
end room$in$table;
fill$entry:
procedure;
if room$in$table then
do;
call move (69,.new$entry,.sched$table(tindx));
scheduling = true;
end;
end fill$entry;
declare last$dseg$byte byte
initial (0);
/*
sched:
*/
sched:
procedure;
sched$pd$adr = os + 2;
sched$lqcb$adr = sched$pd$adr + 52;
sched$uqcb.pointer = .sched$lqcb;
ret = xdos (make$queue,.sched$lqcb);
ret = xdos (open$queue,.cli$uqcb);
do tindx = 0 to 3;
sched$table(tindx).date = 0;
end;
do forever;
ret = xdos (read$queue,.sched$uqcb);
scheduling = false;
call fill$entry;
do while scheduling;
ret = xdos (get$tod,.tod);
scheduling = false;
do tindx = 0 to 3;
if sched$table(tindx).date <> 0 then
do;
if (tod.date > sched$table(tindx).date) or
((tod.date = sched$table(tindx).date) and
((tod.hrs > sched$table(tindx).hrs) or
((tod.hrs = sched$table(tindx).hrs) and
(tod.min >= sched$table(tindx).min)))) then
do;
cli$uqcb.msgadr = .sched$table(tindx).cli$command;
assign$cli$pb(0) = (sched$table(tindx).cli$command(1)
and 0fh);
ret = xdos (assign$console,.assign$cli$pb);
ret = xdos (write$queue,.cli$uqcb);
sched$table(tindx).date = 0;
end;
else
do;
scheduling = true;
end;
end;
end;
if scheduling then
do;
ret = xdos (flag$wait,3);
end;
if xdos (cond$read$queue,.sched$uqcb) = 0
then call fill$entry;
end;
end;
end sched;
end sched;


View File

@@ -0,0 +1,74 @@
era brspbi.asm
pip a:=e:brspbi.asm
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
vax brspbi.lst $$stan
era scrsp.plm
pip a:=e:scrsp.plm
seteof scrsp.plm
era scbrs.plm
pip a:=e:scbrs.plm
seteof scbrs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 scrsp.plm pagewidth(80) debug
era scrsp.plm
link scrsp.obj to scrsp.mod
era scrsp.obj
locate scrsp.mod to scrsp1 code(0000H) stacksize(0)
locate scrsp.mod to scrsp2 code(0100H) stacksize(0)
era scrsp.mod
objhex scrsp1 to scrsp1.hex
objhex scrsp2 to scrsp2.hex
era scrsp2
cpm
objcpm scrsp1
era scrsp1
era scrsp1.com
pip scrsp.hex=scrsp1.hex,scrsp2.hex
genmod scrsp.hex scrsp.rsp
pip e:sched.rsp=scrsp.rsp
pip b:sched.rsp=scrsp.rsp
vax scrsp.lst $$stan
vax scrsp1.sym $$stan
vax scrsp1.lin $$stan
era scrsp*.*
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 scbrs.plm pagewidth(80) debug
era scbrs.plm
link scbrs.obj,brspbi,plm80.lib to scbrs.mod
era scbrs.obj
locate scbrs.mod to scbrs1 code(0000H) stacksize(0)
locate scbrs.mod to scbrs2 code(0100H) stacksize(0)
era scbrs.mod
objhex scbrs1 to scbrs1.hex
objhex scbrs2 to scbrs2.hex
era scbrs2
cpm
objcpm scbrs1
era scbrs1
era scbrs1.com
pip scbrs.hex=scbrs1.hex,scbrs2.hex
genmod scbrs.hex scbrs.brs
pip e:sched.brs=scbrs.brs
pip b:sched.brs=scbrs.brs
vax scbrs.lst $$stan
vax scbrs1.sym $$stan
vax scbrs1.lin $$stan
era scbrs*.*
era *.lst
era *.sym
era *.lin
;end sched submit


View File

@@ -0,0 +1,30 @@
$title('MP/M II V2.0 Scheduler Process - Resident Portion')
sched:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (proces.lit)
$include (queue.lit)
/*
Sched Process Data Segment
*/
declare os address public
data (0);
declare sched$pd process$descriptor public
data (0,rtr$status,100,0,
'Sc',0e8h /* 'h'+80h */,'ed ',0,0,0,0,0);
declare sched$lqcb
structure (lqueue,
buf (71) byte)
initial (0,'Sched ',69,1);
end sched;


View File

@@ -0,0 +1,270 @@
$title('MP/M II V2.0 Spool Process - Banked Portion')
spool:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (proces.lit)
$include (queue.lit)
$include (fcb.lit)
/*
BDOS & XDOS Literals
*/
declare
lo literally '005',
open$file literally '015',
delete$file literally '019',
read$file literally '020',
set$dma literally '026',
free$drives literally '039',
make$queue literally '134',
open$queue literally '135',
read$queue literally '137',
cond$read$queue literally '138',
write$queue literally '139',
cond$write$queue literally '140',
delay literally '141',
dispatch literally '142',
set$priority literally '145',
parse$fname literally '152',
attach$list literally '158',
detach$list literally '159';
/*
Common Literals
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare restarts literally
'0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H';
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;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
declare control$z literally '1AH';
/*
Spool Process Data Segment
*/
declare os address public
/* The OS address will be filled in here by the
MPM Loader, this address is used by Mon1 & Mon2 */
data (0);
declare spool$stack$pointer address
data (.spool$stk+38);
declare nrs$name (8) byte data (
'Spool ');
declare spool$pd$adr address;
declare spool$pd based spool$pd$adr process$descriptor;
declare spool$stk (20) address
initial (restarts,.spool);
declare spool$lqcb$adr address;
declare spool$lqcb based spool$lqcb$adr
structure (lqueue,
buf (192) byte);
declare spool$uqcb userqcbhead
initial (0,.field);
declare stpspl$cqcb$adr address;
declare stpspl$cqcb based stpspl$cqcb$adr circularqueue;
declare stpspl$uqcb address;
declare field (62) byte;
declare disk$select byte at (.field(0));
declare console byte at (.field(1));
declare null byte initial (0);
declare pcb structure (
field$adr address,
fcb$adr address)
initial (0,.fcb);
declare fcb fcb$descriptor;
declare ret byte;
declare (char,column,itab,jtab,eod,i) byte;
declare nxt$chr$adr address;
declare delim based nxt$chr$adr byte;
declare actbuf address;
declare nmbufs address initial (8);
list$buf:
procedure (buf$adr) byte;
declare buf$adr address;
declare buffer based buf$adr (1) byte;
declare i byte;
do i = 0 to 127;
if (char := buffer(i)) = control$z
then return true;
itab = (char = 09H) and (7 - (column and 7));
if char = 09H
then char = ' ';
do jtab = 0 to itab;
if char >= ' '
then column = column + 1;
if char = 0AH then
do;
column = 0;
if mon2 (cond$read$queue,.stpspl$uqcb) = 0 then
do;
nxt$chr$adr = 0;
call mon1 (lo,char);
return true;
end;
end;
call mon1 (lo,char);
end;
end;
return false;
end list$buf;
copy$file:
procedure (buf$base);
declare buf$base address;
declare buffer based buf$base (1) structure (
record (128) byte);
declare ok byte;
declare i address;
do forever;
actbuf = 0;
ok = true;
do while ok;
call mon1 (set$dma,.buffer(actbuf));
if (ok := (mon2 (read$file,.fcb) = 0)) then
do;
ok = ((actbuf := actbuf+1) <> nmbufs);
end;
else
do;
if actbuf = 0 then return;
end;
end;
do i = 0 to actbuf-1;
if list$buf (.buffer(i))
then return;
end;
if actbuf <> nmbufs then return;
end;
end copy$file;
declare spool$buffer (1024) byte;
declare buffer (1) structure (
char (128) byte) at (.spool$buffer);
declare last$dseg$byte byte
initial (0);
/*
spool:
*/
spool:
procedure;
spool$pd$adr = os + 2;
spool$lqcb$adr = spool$pd$adr + 52;
spool$uqcb.pointer = .spool$lqcb;
stpspl$cqcb$adr = spool$lqcb$adr + 24 + 128;
stpspl$uqcb = .stpspl$cqcb;
call mon1 (make$queue,.spool$lqcb);
call mon1 (make$queue,.stpspl$cqcb);
call mon1 (set$priority,201);
do forever;
call mon1 (read$queue,.spool$uqcb);
spool$pd.disk$slct = disk$select;
spool$pd.console = console;
call mon1 (detach$list,0);
if nxt$chr$adr <> 0ffffh
then nxt$chr$adr = .field(1);
do while (nxt$chr$adr <> 0) and
(nxt$chr$adr <> 0FFFFH);
pcb.field$adr = nxt$chr$adr + 1;
nxt$chr$adr = mon2a (parse$fname,.pcb);
if nxt$chr$adr <> 0FFFFH then
do;
fcb.fn(5) = (fcb.fn(5) or 80h);
if mon2 (open$file,.fcb) <> 0FFH then
do;
fcb.nr = 0;
call mon1 (attach$list,0);
call copy$file (.buffer);
call mon1 (detach$list,0);
call mon1 (free$drives,0ffffh);
if (nxt$chr$adr <> 0) and
(delim = '[') then
do;
pcb.field$adr = nxt$chr$adr + 1;
pcb.fcb$adr = .spool$buffer;
nxt$chr$adr = mon2a (parse$fname,.pcb);
if nxt$chr$adr <> 0ffffh then
do;
if spool$buffer(1) = 'D' then
do;
fcb.ex = 0;
call mon1 (delete$file,.fcb);
end;
if (nxt$chr$adr <> 0) and
(delim <> ']') then
do;
nxt$chr$adr = 0ffffh;
end;
end;
pcb.fcb$adr = .fcb;
end;
end;
end;
end; /* of while */
end;
end spool;
/*
Dummy Main Program
*/
do;
;
end;
end spool;


View File

@@ -0,0 +1,72 @@
era brspbi.asm
pip a:=e:brspbi.asm
seteof brspbi.asm
isx
asm80 brspbi.asm pagewidth(80) debug
era brspbi.asm
ren brspbi=brspbi.obj
cpm
vax brspbi.lst $$stan
era sprsp.plm
pip a:=e:sprsp.plm
seteof sprsp.plm
era spbrs.plm
pip a:=e:spbrs.plm
seteof spbrs.plm
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 sprsp.plm pagewidth(80) debug
era sprsp.plm
link sprsp.obj to sprsp.mod
era sprsp.obj
locate sprsp.mod to sprsp1 code(0000H) stacksize(0)
locate sprsp.mod to sprsp2 code(0100H) stacksize(0)
era sprsp.mod
objhex sprsp1 to sprsp1.hex
objhex sprsp2 to sprsp2.hex
era sprsp2
cpm
objcpm sprsp1
era sprsp1
era sprsp1.com
pip sprsp.hex=sprsp1.hex,sprsp2.hex
genmod sprsp.hex sprsp.rsp
pip e:spool.rsp=a:sprsp.rsp
pip b:spool.rsp=a:sprsp.rsp
vax sprsp.lst $$stan
vax sprsp1.sym $$stan
vax sprsp1.lin $$stan
era sprsp*.*
era *.lst
era *.sym
era *.lin
era *.bak
isx
plm80 spbrs.plm pagewidth(80) debug
era spbrs.plm
link spbrs.obj,brspbi,plm80.lib to spbrs.mod
era spbrs.obj
locate spbrs.mod to spbrs1 code(0000H) stacksize(0)
locate spbrs.mod to spbrs2 code(0100H) stacksize(0)
era spbrs.mod
objhex spbrs1 to spbrs1.hex
objhex spbrs2 to spbrs2.hex
era spbrs2
cpm
objcpm spbrs1
era spbrs1
era spbrs1.com
pip spbrs.hex=spbrs1.hex,spbrs2.hex
genmod spbrs.hex spbrs.brs
pip e:spool.brs=a:spbrs.brs
pip b:spool.brs=a:spbrs.brs
vax spbrs.lst $$stan
vax spbrs1.sym $$stan
vax spbrs1.lin $$stan
era spbrs*.*
era brspbi.*
;end spool submit


View File

@@ -0,0 +1,41 @@
$title('MP/M II V2.0 Spool Process - Resident Portion')
spool:
do;
$include (copyrt.lit)
/*
Revised:
14 Sept 81 by Thomas Rolander
*/
$include (proces.lit)
$include (queue.lit)
/*
Spool Process Data Segment
*/
declare os address public
/* The OS address will be filled in here by the
MPM Loader, this address is used by Mon1 & Mon2 */
data (0);
declare spool$pd process$descriptor public
/* This is 'data' because it must precede
the PRL file code segment */
data (0,0,20,0,
'Sp',0efh /* 'o'+80h */,'ol ',
0a0h /* ' '+80h */,0,0,0);
declare spool$lqcb
structure (lqueue,
buf (128) byte)
data (0,'SPOOLQ ',62,2);
declare stpspl$cqcb circularqueue
data (0,'STOPSPLR',0,1);
declare last byte
data (0);
end spool;