seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-28 02:44:19 +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

50
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/pxios.a86 Normal file
View File

@@ -0,0 +1,50 @@
; Interface to call Physical XIOS
; From a process not in the O.S.
; code reentrant, separate data areas per process
; used by VOUT and PIN RSPs
name pxios
cgroup group code
dgroup group dats
assume cs:cgroup
assume ds:dgroup
dats segment public 'DATA'
extrn rsplink:word ;segment of SYSDAT
extrn udaseg:word ;UDA must be in ES for XIOS call
extrn u_retseg:word, u_wrkseg:word, u_insys:byte
dats ends
code segment public 'CODE'
public pxios1, pxios2, pxios3, pxios4
xiosmod equ 28h
p_uda equ 10h
rlr equ 68h
pxios2 equ pxios1
pxios3 equ pxios1
pxios4 equ pxios1
pxios1 proc
push bp
mov bp,sp
mov ax,[bp+8] ;set up registers
mov cx,[bp+6]
mov dx,[bp+4]
push ds
mov ds,rsplink ;SYSDAT
mov si,ds:word ptr rlr ;ready list root
mov es,[p_uda+si] ;UDA
call ds:dword ptr [xiosmod]
pop ds
pop bp
ret 6
pxios1 endp
code ends
end

68
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/pxios.lst Normal file
View File

@@ -0,0 +1,68 @@
8086/8087/8088 MACRO ASSEMBLER PXIOS 18:10:30 04/22/83 PAGE 1
VAX/VMS 8086/8087/8088 MACRO ASSEMBLER V1.0 ASSEMBLY OF MODULE PXIOS
OBJECT MODULE PLACED IN PXIOS.OBJ
NO INVOCATION LINE CONTROLS
LOC OBJ LINE SOURCE
1 ; Interface to call Physical XIOS
2 ; From a process not in the O.S.
3 ; code reentrant, separate data areas per process
4 ; used by VOUT and PIN RSPs
5
6 name pxios
7
8 cgroup group code
9 dgroup group dats
10
11 assume cs:cgroup
12 assume ds:dgroup
13
---- 14 dats segment public 'DATA'
15 extrn rsplink:word ;segment of SYSDAT
16 extrn udaseg:word ;UDA must be in ES for XIOS call
17 extrn u_retseg:word, u_wrkseg:word, u_insys:byte
---- 18 dats ends
19
---- 20 code segment public 'CODE'
21 public pxios1, pxios2, pxios3, pxios4
0028 22 xiosmod equ 28h
0010 23 p_uda equ 10h
0068 24 rlr equ 68h
25
0000 26 pxios2 equ pxios1
0000 27 pxios3 equ pxios1
0000 28 pxios4 equ pxios1
29
0000 30 pxios1 proc
0000 55 31 push bp
0001 8BEC 32 mov bp,sp
33
0003 8B4608 34 mov ax,[bp+8] ;set up registers
0006 8B4E06 35 mov cx,[bp+6]
0009 8B5604 36 mov dx,[bp+4]
37
000C 1E 38 push ds
000D 8E1E0000 E 39 mov ds,rsplink ;SYSDAT
0011 8B366800 40 mov si,ds:word ptr rlr ;ready list root
0015 8E4410 41 mov es,[p_uda+si] ;UDA
0018 FF1E2800 42 call ds:dword ptr [xiosmod]
001C 1F 43 pop ds
44
001D 5D 45 pop bp
001E C20600 46 ret 6
47 pxios1 endp
48
---- 49 code ends
50 end
8086/8087/8088 MACRO ASSEMBLER PXIOS 18:10:30 04/22/83 PAGE 2
LOC OBJ LINE SOURCE
ASSEMBLY COMPLETE, NO ERRORS FOUND

118
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/rhvout.a86 Normal file
View File

@@ -0,0 +1,118 @@
; Code and Data Interface for VOUT RSP
; (for virtual console support)
; March 30, 1983
name rvout
cgroup group code
dgroup group dats
assume cs:cgroup,ds:dgroup
public xdos,mon1,mon2,mon3,mon4,intsys
public rsplink,pd,udaseg,u_retseg,u_wrkseg
public u_insys, ncopies
extrn plmstart:near
dats segment public 'DATA'
org 0
rsphdr_len equ 16
pd_len equ 30H
uda_len equ 100H
insysoff equ 60H
rsp_top equ 0
rsp_pd equ rsp_top + rsphdr_len
rsp_uda equ rsp_pd + pd_len
rsp_bottom equ rsp_uda + uda_len
org rsp_top
;RSP header
rsplink dw 0 ;becomes system data page paragraph
sdatvar dw nvcns ;gensys makes a copy per virtual cons
ncopies db 0
dw 0,0,0,0, 0
db 0
org rsp_pd
pd dw 0,0 ;link fields
db 0 ;status
db 180 ;initial priority - better than TMPs and PIN
dw 3 ;flags - system and keep
db 'VOUT ' ;name
udaseg dw rsp_uda/10h ;uda paragraph
db 0,0 ;disk,user
db 0,0 ;ldisk,luser
dw 0ffh ;puremem - re-entrant
;rest of pd
org rsp_uda ;start of uda
uda dw 0
dw 0 ;init DMA, must be set by program
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw offset stk_top
dw 0,0,0,0, 0,0,0,0
u_wrkseg dw 0
u_retseg dw 0
org rsp_uda + insysoff
u_insys db 1
db 0 ;status save
dw 0 ;ccb
dw 0 ;lcb
db 0 ;delimiter for print string
db 93h dup (0cch) ;fill UDA stack with INT 3s
stk_top dw plmstart
dw 0,0 ;segment and flags - unknown
dats ends
code segment public 'CODE'
db 'COPYRIGHT (C) 1983,'
db ' DIGITAL RESEARCH '
xdos proc
push bp
mov bp,sp
mov dx,[bp+4]
mov cx,[bp+6]
int 224
pop bp
ret 4
xdos endp
mon1 equ xdos
mon2 equ xdos
mon3 equ xdos
mon4 equ xdos
supervisor equ 0
rlr equ 68h
p_uda equ 10h
nvcns equ 47h
intsys proc ;call O.S. as if we are
push bp ;already in it
mov bp,sp
mov bx, [bp+4]
mov dx, [bp+6]
mov cx, [bp+8]
push ds
mov ds, rsplink ;DS = Sysdat Segment
mov si, ds:word ptr rlr
mov es, [si + p_uda]
call ds:dword ptr [supervisor]
pop ds
pop bp
ret 6
intsys endp
code ends
end

190
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/rhvout.lst Normal file
View File

@@ -0,0 +1,190 @@
8086/8087/8088 MACRO ASSEMBLER RVOUT 18:10:17 04/22/83 PAGE 1
VAX/VMS 8086/8087/8088 MACRO ASSEMBLER V1.0 ASSEMBLY OF MODULE RVOUT
OBJECT MODULE PLACED IN RHVOUT.OBJ
NO INVOCATION LINE CONTROLS
LOC OBJ LINE SOURCE
1 ; Code and Data Interface for VOUT RSP
2 ; (for virtual console support)
3 ; March 30, 1983
4
5 name rvout
6
7 cgroup group code
8 dgroup group dats
9
10 assume cs:cgroup,ds:dgroup
11
12 public xdos,mon1,mon2,mon3,mon4,intsys
13 public rsplink,pd,udaseg,u_retseg,u_wrkseg
14 public u_insys, ncopies
15 extrn plmstart:near
16
17
---- 18 dats segment public 'DATA'
0000 19 org 0
20
0010 21 rsphdr_len equ 16
0030 22 pd_len equ 30H
0100 23 uda_len equ 100H
0060 24 insysoff equ 60H
0000 25 rsp_top equ 0
0010 26 rsp_pd equ rsp_top + rsphdr_len
0040 27 rsp_uda equ rsp_pd + pd_len
0140 28 rsp_bottom equ rsp_uda + uda_len
0000 29 org rsp_top
30 ;RSP header
0000 0000 31 rsplink dw 0 ;becomes system data page paragraph
0002 4700 32 sdatvar dw nvcns ;gensys makes a copy per virtual cons
0004 00 33 ncopies db 0
0005 0000 34 dw 0,0,0,0, 0
0007 0000
0009 0000
000B 0000
000D 0000
000F 00 35 db 0
0010 36 org rsp_pd
0010 0000 37 pd dw 0,0 ;link fields
0012 0000
0014 00 38 db 0 ;status
0015 B4 39 db 180 ;initial priority - better than TMPs and PIN
0016 0300 40 dw 3 ;flags - system and keep
0018 564F5554202020 41 db 'VOUT ' ;name
20
0020 0400 42 udaseg dw rsp_uda/10h ;uda paragraph
0022 00 43 db 0,0 ;disk,user
0023 00
8086/8087/8088 MACRO ASSEMBLER RVOUT 18:10:17 04/22/83 PAGE 2
LOC OBJ LINE SOURCE
0024 00 44 db 0,0 ;ldisk,luser
0025 00
0026 FF00 45 dw 0ffh ;puremem - re-entrant
46 ;rest of pd
47
0040 48 org rsp_uda ;start of uda
0040 0000 49 uda dw 0
0042 0000 50 dw 0 ;init DMA, must be set by program
0044 0000 51 dw 0,0,0,0, 0,0,0,0, 0,0,0,0
0046 0000
0048 0000
004A 0000
004C 0000
004E 0000
0050 0000
0052 0000
0054 0000
0056 0000
0058 0000
005A 0000
005C 0000 52 dw 0,0,0,0, 0,0,0,0, 0,0,0,0
005E 0000
0060 0000
0062 0000
0064 0000
0066 0000
0068 0000
006A 0000
006C 0000
006E 0000
0070 0000
0072 0000
0074 3A01 R 53 dw offset stk_top
0076 0000 54 dw 0,0,0,0, 0,0,0,0
0078 0000
007A 0000
007C 0000
007E 0000
0080 0000
0082 0000
0084 0000
0086 0000 55 u_wrkseg dw 0
0088 0000 56 u_retseg dw 0
57
00A0 58 org rsp_uda + insysoff
00A0 01 59 u_insys db 1
00A1 00 60 db 0 ;status save
00A2 0000 61 dw 0 ;ccb
00A4 0000 62 dw 0 ;lcb
00A6 00 63 db 0 ;delimiter for print string
64
00A7 (147 65 db 93h dup (0cch) ;fill UDA stack with INT 3s
CC
)
66
8086/8087/8088 MACRO ASSEMBLER RVOUT 18:10:17 04/22/83 PAGE 3
LOC OBJ LINE SOURCE
013A 0000 E 67 stk_top dw plmstart
013C 0000 68 dw 0,0 ;segment and flags - unknown
013E 0000
69
---- 70 dats ends
71
---- 72 code segment public 'CODE'
73
0000 434F5059524947 74 db 'COPYRIGHT (C) 1983,'
48542028432920
313938332C
0013 20444947495441 75 db ' DIGITAL RESEARCH '
4C205245534541
52434820
76
0025 77 xdos proc
0025 55 78 push bp
0026 8BEC 79 mov bp,sp
0028 8B5604 80 mov dx,[bp+4]
002B 8B4E06 81 mov cx,[bp+6]
002E CDE0 82 int 224
0030 5D 83 pop bp
0031 C20400 84 ret 4
85 xdos endp
86
0025 87 mon1 equ xdos
0025 88 mon2 equ xdos
0025 89 mon3 equ xdos
0025 90 mon4 equ xdos
91
0000 92 supervisor equ 0
0068 93 rlr equ 68h
0010 94 p_uda equ 10h
0047 95 nvcns equ 47h
96
0034 97 intsys proc ;call O.S. as if we are
0034 55 98 push bp ;already in it
0035 8BEC 99 mov bp,sp
100
0037 8B5E04 101 mov bx, [bp+4]
003A 8B5606 102 mov dx, [bp+6]
003D 8B4E08 103 mov cx, [bp+8]
104
105
0040 1E 106 push ds
0041 8E1E0000 R 107 mov ds, rsplink ;DS = Sysdat Segment
0045 8B366800 108 mov si, ds:word ptr rlr
0049 8E4410 109 mov es, [si + p_uda]
004C FF1E0000 110 call ds:dword ptr [supervisor]
0050 1F 111 pop ds
112
0051 5D 113 pop bp
0052 C20600 114 ret 6
115 intsys endp
116
8086/8087/8088 MACRO ASSEMBLER RVOUT 18:10:17 04/22/83 PAGE 4
LOC OBJ LINE SOURCE
---- 117 code ends
118 end
ASSEMBLY COMPLETE, NO ERRORS FOUND

18
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/vout.com Normal file
View File

@@ -0,0 +1,18 @@
$ !
$ ! this proc compiles, links and generates in hex the VOUT process RSP
$ ! for Concurrent CP/M-86: vers IBM PC 1.0
$ ! It is assumed that the BATCH command is used for
$ ! setting the default directory
$ !
$ set verify
$ def sys$print nowhere ! log file goes to syslogin
$ newplm ! use NEW plm compiler
$ as86 rhvout.a86
$ as86 pxios.a86
$ pl86 vout.plm optimize(3) debug xref 'p1' 'p2' 'p3'
$ li86 rhvout.obj, pxios.obj, vout.obj to rhvout.lnk
$ ren rhvout.lnk vout.lnk
$ lo86 vout.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0),dats(10000h))) ss(stack(0)) to vout.dat
$ newh86 vout.dat
$ pclean

210
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/vout.h86 Normal file
View File

@@ -0,0 +1,210 @@
:020000021000EC
:1000000000004700000000000000000000000000A9
:020000021001EB
:100000000000000000B40300564F5554202020206B
:08001000040000000000FF00E5
:020000021004E8
:1000000000000000000000000000000000000000F0
:1000100000000000000000000000000000000000E0
:1000200000000000000000000000000000000000D0
:10003000000000003A010000000000000000000085
:0A00400000000000000000000000B6
:02000002100AE2
:0700000001000000000000F8
:02000002100AE2
:10000700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC29
:10001700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC19
:10002700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC09
:10003700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCF9
:10004700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCE9
:10005700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCD9
:10006700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC9
:10007700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCB9
:10008700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA9
:03009700CCCCCC02
:020000021013D9
:06000A00FC0500000000EF
:020000020000FC
:10000000434F5059524947485420284329203139F9
:1000100038332C204449474954414C2052455345DC
:100020004152434820558BEC8B56048B4E06CDE055
:100030005DC20400558BEC8B5E048B56068B4E081C
:100040001E8E1E00008B3668008E4410FF1E0000BE
:050050001F5DC2060067
:020000020006F6
:10000000558BEC8B46088B4E068B56041E8E1E00BD
:10001000008B3668008E4410FF1E28001F5DC2064C
:0100200000DF
:02000002101CD0
:0100040000FB
:02000002101CD0
:01000500FFFB
:02000002101CD0
:01000600FFFA
:02000002101CD0
:01000700FFF9
:020000021014D8
:02000E000000F0
:020000021015D7
:020000000000FE
:020000021015D7
:02000200FFFFFE
:020000021015D7
:02000400FFFFFC
:020000021015D7
:020006000000F8
:02000002102CC0
:0100090000F6
:02000002102CC0
:01000C0000F3
:020000021015D7
:10000E00000000000600564F5554512020200200DB
:0C001E0010000000000000000000D202F2
:020000021017D5
:10000A0000000000060056494E5120202020010021
:0C001A0040000000000000000000F202A6
:020000021019D3
:1000060000000000070056434D58512020200000F4
:0C001600010000000000000000000000DD
:020000021035B7
:010006005A9F
:020000021033B9
:0C00020000202020202020202024242486
:020000020008F4
:10000200558BECB8120250FF7604B8090050E8A1F3
:05001200FF5DC20200C9
:020000020009F3
:10000700558BECB8130250FF7604B8000050E88C0B
:05001700FF5DC20200C4
:02000002000AF2
:10000C00558BECC41E4401268B4716A3B401B08952
:0A001C0050B8B20150E861FF5DC367
:02000002000CF0
:10000600558BECC41E4401268B4716A3B401B08B56
:0A00160050B8B20150E847FF5DC387
:02000002000EEE
:10000000558BECB01050B8320350E838FFB01350A5
:10001000B8320350E82EFFC606C50100C606C60169
:03002000FF5DC3BE
:020000020010EC
:10000300558BEC8D3E3E03B000B918001E07FCF281
:10001300AAC41E4001268A4750FEC0A23203B01371
:1000230050B8320350E8FAFEB01650B8320350E825
:10003300F0FE3CFF7504B0005DC3C606C60100B008
:03004300FF5DC39B
:020000020014E8
:10000600558BECC606C501FFC606C701FFB000A2A8
:0C001600C401B400A35001A34E015DC35F
:020000020016E6
:10000200558BECA0C601D0D8730BE894FFF6D0D084
:10001200D87310EB42A14E013B0650017505A0C7F3
:1000220001EBEAA0C401F6D0D0D8730FB01A50B8D1
:10003200C80150E88DFEC606C401FFA15001A253BB
:1000420003A1500188E0A25403B02250B8320350F9
:10005200E870FE3C007404B0005DC3C606C7010030
:10006200C7065201FFFFA1500140C41E44015026A1
:100072008B4710B90800F7E189C15831D2F7F189ED
:07008200165001B0FF5DC341
:02000002001EDE
:10000900558BECA0C701D0D87310A0C601F6D0D08B
:10001900D87303E847FFB0005DC3A0C401D0D8730B
:100029000FB01A50B8480250E811FEC606C40100C4
:10003900A14E01A25303A14E0188E0A25403B021AD
:1000490050B8320350E8F4FD3C00B0FF740140A2FF
:10005900C802A14E0140C41E440150268B4710B965
:100069000800F7E189C15831D2F7F189164E013BF1
:0D0079001650017503E8E5FEA0C8025DC346
:020000020026D6
:10000600558BECA0C902D0D873025DC3C41E44014F
:10001600268B4714A3B401C706B8014C01B089501A
:10002600B8B20150E898FD803E4D01007505C60640
:05003600C902FF5DC3DB
:020000020029D3
:10000B00558BECC41E4401268B4714A3B401C706C1
:10001B00B8014C01C606CA0200C606CB0200A0CA34
:10002B0002F6D08A0ECB02F6D122C1D0D87324B0FF
:10003B008A50B8B20150E851FD3C00750F803E4D1F
:10004B000100B0FF740140A2CA02EBD2C606CB027C
:10005B00FFEBCBA04C018B5E048807A0CB02D0D862
:0C006B007304B000EB02B0FF5DC20200A5
:020000020030CC
:10000700558BECC606C90200803E4D01007520C61F
:10001700064D01FFA1520140A352018A0E4C0189EE
:10002700C3888FC80183F87F7505E82EFE5DC3B0CE
:03003700FF5DC3A7
:020000020033C9
:10000A00558BECA15401403B065601757FE89FFED3
:10001A00D0D8730EC70656018000C7065401FFFFE9
:10002A00EB6A833E5201FF74248B0E520141BEC813
:10003A0001BF48021E07FCF2A4C606CC0200A15268
:10004A000140A35601C7065201FFFFEBCDA0C9022A
:10005A00D0D8730AC606C90200A04C01EB3BFF7652
:10006A0004E8FDFEF6D0D0D87334C41E4401268AB3
:10007A00470424103C00740CB08D50B8020050E8BC
:10008A0069FCEBE6FF7604E8D7FEEB14A1540140C5
:10009A00A3540189C38A8748028B5E048807B0FF8C
:0400AA005DC2020031
:02000002003DBF
:10000E00558BECE8C8FCC41E4401268B470E250414
:10001E000083F800750626814F0E4000E8C9FC5D8E
:01002E00C30E
:02000002003FBD
:10000F00558BECA0CC02D0D87305E856FDEB16C487
:10001F001E4401268B470E25FFFD83F8037514E858
:10002F0045FEE8E3FEF6D0A2CC02D0D873E1E8AEED
:05003F00FF5DC35DC37D
:020000020043B9
:10000400558BECC606D002FFC41E4401268B470E56
:1000140025A20083F800B0FF7401402206D002D06C
:10002400D87203E9DA00E84FFCC41E4401268B476A
:100034000E5025000283F800B0FF750140A2CF02E4
:100044005825A20083F8007403E9AE00FAC41E44E4
:1000540001268A470424083C0074098D472250E88D
:10006400ECFBEBE9C41E440126804F0408FBC606E2
:10007400CE0200803ECE0228B0FF7201402206D09C
:1000840002D0D8735CB8CD0250E87AFEA2D002C484
:100094001E4401268B4F0E81E100015083F900B00C
:1000A400FF7401405922C1D0D87330B00250A0CDA2
:1000B40002B40050A00400B40050E86FFBA0CF02CB
:1000C400D0D87317B00450A0CD02B40050C41E445D
:1000D40001268A4708B40050E851FBFE06CE02EB25
:1000E40092C41E440126806704F7E8A5FBC41E449D
:1000F400018D472250E86BFBEB03E895FBE908FF11
:10010400A0D002F6D0D0D87338C70656010000C775
:10011400065401FFFFC7065201FFFFE85AFBC41E45
:100124004401268B470E250400B900003BC1740E20
:100134002681670EFBFFB008505151E8EEFAE851F2
:0E014400FBC41E44018D472450E817FB5DC329
:020000020058A4
:10000200558BECB8580150E80FFDD0D872F5E819BD
:10001200FBC41E44012681670EDFFFE826FBE8A32E
:10002200FBC606CC0200C7065401FFFFC7065201F9
:10003200FFFFC70656010000C41E44018D4724502D
:05004200E8D2FA5DC3E5
:02000002005CA0
:10000700558BEC8B76048D7406B90800BFBA011EB8
:1000170007FCF2A4B08650FF7604E841FAA2D102A9
:10002700B08750B8B20150E834FA0806D102A1B43B
:05003700015DC20200A2
:02000002005F9D
:10000C00558BECB02D50B8FF0050E81CFAA1000045
:10001C00A34601A34201C70640010000A00400B49E
:10002C0000B92C00F7E1C41E400126034754A34439
:10003C0001B09C50B8000050E8EEF9891E5A018CB2
:10004C00065C01C4365A018D74088D3E3303B90821
:10005C00001E061E071FFCF2A41FB90400BE3703C6
:10006C00BF84011E07FCF2A4B87A0150E85CFFC4FF
:10007C001E440126894712B90300BE3703BF69012C
:10008C001E07FCF2A4B85E0150E83FFFC41E4401F9
:10009C0026894714B90300BE3703BFA1011E07FC14
:1000AC00F2A4B8960150E822FFC41E4401268947E9
:1000BC0016B09450A00400B40050E86CF9C41E4073
:1000CC0001268A4750FEC0A23203E8FDF9B09150D8
:1000DC00B8C80050E852F9A0C501D0D87303E803A2
:1000EC00FAC41E4401268B470E25FFFC83F80375CA
:1000FC0005E80FFDEB2BC41E4401268B470E25FF94
:10010C00FC25040083F8007405E82CFDEB13C41ED9
:10011C004401268B470E25200083F8007403E86504
:10012C00FEA0C501D0D87305E8B9F9EBAAE83AFBF3
:04013C00EBA55DC30F
:00000001FF

1242
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/vout.lst Normal file
View File

File diff suppressed because it is too large Load Diff

492
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/vout/vout.plm Normal file
View File

@@ -0,0 +1,492 @@
$title('VOUT.RSP - virtual console disk write')
$set(debug=0)
$compact
vout:
do;
/* Disk output process. Reads Virtual OUTput Queue (VOUTQ) associated
with a virtual console in buffered background mode. Output is spooled
to the file VOUTX.$$$. When console is in foreground purge mode, spooled
output is read from this file and dumped on the screen. There is one
copy of the VOUT process per virtual console. Each VOUT RSP has
its own data area, but the code is reentrant for all the VOUT RSPs.
*/
/* VAX commands used to generate VOUT.RSP
asm86 rvout.a86
plm86 vout.plm optimize(3) debug 'p1' 'p2' 'p3'
link86 rvout.obj, pxios.obj, vout.obj to vout.lnk
loc86 vout.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0))) ss(stack(0))
h86 vout.dat
refmt vout.mp2 vout.2
ren vout.2 vout.mp2
the hex is uploaded to a micro to make a binary file using the command:
gencmd vout data[bxxx]
xxx is taken from the VOUT.MP2 file generated on the VAX by LOC86.
xxx is the next paragraph after the CODE segment.
*/
$include (:f1:copyrt.lit)
$include (:f1:comlit.lit)
$include (:f1:qd.lit)
$include (:f1:mfunc.lit)
$include (:f1:mxfunc.lit)
$include (:f1:fcb.lit)
dcl name$len lit '4'; /* number of letters in RSP name: 'VOUT' */
dcl fcblen lit '36';
dcl rsplink word external; /* set to SYSDAT by O.S. initialization */
dcl udaseg word external; /* DS for this process */
dcl ncopies byte external;
dcl copynum byte at (.ncopies); /* VOUT process copy number, also the */
/* virtual console number for console */
/* output to the XIOS */
$include (:f1:sd.lit)
dcl ccb$pointer pointer;
dcl ccb$ptr structure ( offset address, segment address) at
(@ccb$pointer);
$include (:f1:vccb.lit)
dcl ccb based ccb$pointer ccb$structure;
dcl data$msg lit '0';
dcl wake$msg lit '0ffh';
dcl voutq$msg structure (
dayta byte, type byte);
mon1: procedure (func,a) external;
dcl func byte, a address;
end mon1;
mon2: procedure (func,a) byte external;
dcl func byte, a address;
end mon2;
mon4: procedure (func,a) pointer external;
dcl func byte, a address;
end mon4;
intsys: procedure (cx, dx, bx) external; /* internal O.S. functions */
dcl (cx, dx, bx) word; /* see RVOUT module */
end intsys;
/* special disk output assembly module */
pxios1: procedure (func,p1,p2) external;
dcl func byte, (p1,p2) address; /* XIOS interface for process */
end pxios1; /* not in the O.S. */
dcl ps$ciosleep lit '9';
sleep: procedure(addr);
dcl addr word;
call intsys(mi$sleep, addr, ps$ciosleep);
end sleep;
wakeup: procedure(addr);
dcl addr word;
call intsys(mi$wakeup, addr, 0);
end wakeup;
$if debug=1
/* conditionally compiled error print routines */
print$msg: procedure(endchar, sptr);
dcl (i, endchar) byte, sptr pointer,
string based sptr (1) byte;
i = 0;
do while string(i) <> endchar;
call pxios1(mx$conout, string(i), copynum);
i = i + 1;
end;
end print$msg;
print$hex: procedure (nib);
dcl nib byte;
nib = nib and 0fh;
if nib < 10 then
call pxios1(mx$conout, nib + '0', copynum);
else
call pxios1(mx$conout, nib + 'A' - 10, copynum);
end print$hex;
error: procedure(msgptr);
dcl msgptr pointer;
call print$msg(0, @(cr, lf, '**** VOUT ERROR **** ',0));
call print$msg(0, msgptr);
call print$msg(0, @(', CCB.STATE = ', 0));
call print$hex(shr(ccb.state, 12));
call print$hex(shr(ccb.state, 8));
call print$hex(shr(ccb.state, 4));
call print$hex(ccb.state);
call print$msg(0, @('H', cr, lf, 0));
end error;
$endif
read$change$mxq: procedure;
qpb.qaddr = ccb.vcmxq;
call mon1 (m$readq, .qpb);
end read$change$mxq;
write$change$mxq: procedure;
qpb.qaddr = ccb.vcmxq;
call mon1 (m$writeq, .qpb);
end write$change$mxq;
dcl logeof lit '0ffh';
dcl dump$op lit '0ffh';
dcl writing boolean initial (false);
dcl delete$flag boolean initial (true); /* delete when convienient */
dcl deleted boolean initial (true); /* has been deleted */
dcl file$is$empty boolean initial (true);
dcl rrr address initial(0); /* next random record to read */
dcl wrr address initial(0); /* next random record to write */
delete$file: procedure;
call mon1(m$closef, .fcb); /* force allocation vector */
call mon1(m$deletef, .fcb); /* update */
delete$flag = false;
deleted = true;
end delete$file;
make$file: procedure boolean;
call setb(0, @fcb(f$ex), fcblen-f$ex);
fcb(f$drvusr) = sd.tempdisk + 1; /* try deleting the file in case drive */
call mon1(m$deletef, .fcb); /* was read only when delet$file was */
/* called or tempdisk has changed */
if mon2(m$makef, .fcb) = 0ffh then /* open in locked mode */
return(false); /* error - force open attempt next time */
deleted = false;
return(true);
/* fcb(f$ex) = fcb(f$ex) or 80h; /* make system */
/* call mon1(m$setatt, .fcb); */
end make$file;
reset$file: procedure;
delete$flag, file$is$empty = true;
writing = false; /* force setdma */
wrr, rrr = 0; /* not necessary ? */
end reset$file;
dcl bufsiz lit '128';
dcl in$buf(bufsiz) byte; /* buffer to fill on from reading VOUTQ */
dcl in$ptr word initial (0ffffh); /* initially empty buffer */
dcl purge$buf (buf$siz) byte; /* buffer to use when purging */
dcl purge$ptr word initial (0ffffh);
dcl num$purge$buf$chars word initial (0);
write$buf: procedure boolean;
if deleted then
do;
if not make$file then /* delete and make file */
return(false);
end;
else if rrr = wrr and not file$is$empty then
return(false); /* don't write if we haven't purged it yet */
if not writing then /* we want to be in write mode */
do;
call mon1(m$setdma,.in$buf);
writing = true;
end;
fcb(f$rrec) = low(wrr);
fcb(f$rrec+1) = high(wrr);
if mon2(m$writerf, .fcb) <> 0 then
return(false); /* out of disk space or physical error */
file$is$empty = false;
in$ptr = 0ffffh;
wrr = (wrr + 1) mod (ccb.maxbufsiz * 8); /* next record to write */
return(true);
end write$buf;
read$buf: procedure boolean;
dcl ret boolean;
if file$is$empty then
do;
if not deleted then /* made file but had a write error */
call reset$file;
return(false);
end;
if writing then /* we want to be in read mode */
do;
call mon1(m$setdma, .purge$buf);
writing = false;
end;
fcb(f$rrec) = low(rrr);
fcb(f$rrec+1) = high(rrr);
ret = mon2(m$readrf,.fcb) = 0; /* physical error if false - skips record */
rrr = (rrr + 1) mod (ccb.maxbufsiz * 8);
if rrr = wrr then /* done with file ? */
call reset$file;
return(ret); /* return read status */
end read$buf;
dcl active$msg boolean initial (false);
read$voutq: procedure;
if active$msg then
return;
qpb.qaddr = ccb.voutq;
qpb.buffptr = .voutq$msg;
call mon1(m$readq, .qpb);
if voutq$msg.type = data$msg then
active$msg = true;
end read$voutq;
drain$voutq: procedure(char$adr) boolean;
dcl char$adr address; /* return false if no chars found in */
dcl char based char$adr byte; /* VOUTQ, return true and put char @ */
dcl (have$a$char, qempty) boolean; /* char$adr if there is one */
qpb.qaddr = ccb.voutq;
qpb.buffptr = .voutq$msg;
have$a$char, qempty = false;
do while not have$a$char and not qempty;
if mon2(m$creadq, .qpb) = 0 then /* successful queue read */
have$a$char = voutq$msg.type = data$msg; /* and msg is data */
else
qempty = true;
end;
char = voutq$msg.dayta;
if qempty then
return(false); /* no chars in queue */
return(true); /* char was a data msg */
end drain$voutq;
put$char: procedure boolean;
active$msg = false;
if voutq$msg.type <> data$msg then
return(true);
voutq$msg.type = wake$msg; /* probably garbage */
in$buf(in$ptr := in$ptr + 1) = voutq$msg.dayta;
if in$ptr = buf$siz - 1 then
return(write$buf); /* don't call again no write */
return(true);
end put$char;
get$char: procedure (charadr) boolean;
dcl charadr address, char based charadr byte;
if purge$ptr + 1 = num$purge$buf$chars then
if read$buf then
do;
num$purge$buf$chars = bufsiz;
purge$ptr = 0ffffh;
end;
else if in$ptr <> 0ffffh then /* data in buff but not in file */
do;
call move(in$ptr + 1, .in$buf, .purge$buf);
write$pending = false;
num$purge$buf$chars = in$ptr + 1;
in$ptr, purge$ptr = 0ffffh; /* indicate data in purge$buf */
end;
else if active$msg then
do;
active$msg = false;
char = voutq$msg.dayta;
return(true);
end;
else
do;
if not drain$voutq(char$adr) then /* get chars from VOUTQ */
do;
do while (ccb.flag and cf$vout) <> 0; /* user process is NQing wait */
call mon1(m$delay, 2); /* for q write to finish */
end;
return(drain$voutq(char$adr)); /* now read message, usr proc */
end; /* sleeps because of state */
else
return(true); /* got a char from VOUTQ */
end;
purge$ptr = purge$ptr + 1;
char = purge$buf(purge$ptr);
return (true);
end get$char;
full$disk: procedure; /* arrive when we can't write*/
call read$change$mxq; /* to the disk */
if (ccb.state and csm$purging) = 0 then /* wait for PIN to switch us */
/* to the foreground, */
ccb.state = ccb.state or csm$filefull; /* csm$file$full and csm$pur-*/
/* ging are mutually exclusive*/
call write$change$mxq;
end full$disk;
dcl write$pending boolean initial (false);
buffer: procedure;
if write$pending then
if write$pending := not write$buf then
do;
call full$disk;
return;
end;
do while (ccb.state and not double(csm$ctrlP)) =
csm$buffered + csm$background;
call read$voutq; /* always do something with the */
if write$pending := not putchar then /* character ! */
do;
call full$disk;
return;
end;
end;
end buffer;
dcl purgeok$mask lit '(csm$background or csm$abort or csm$ctrlS)';
purge: procedure;
dcl (char, count) byte;
dcl controlP boolean;
dcl more$in$file boolean;
more$in$file = true;
do while (ccb.state and purgeok$mask) = 0 and
more$in$file;
call read$change$mxq;
controlP = (ccb.state and csm$ctrlP) <> 0;
if (ccb.state and purgeok$mask) = 0 then
do;
disable;
do while (ccb.flag and cf$conout) <> 0;
call sleep(.ccb.cosleep);
end;
ccb.flag = ccb.flag or cf$conout;
enable;
count = 0;
do while more$in$file and count < 40; /* for performance, purge 40 */
if (more$in$file := get$char(.char)) and /* chars before allowing */
(ccb.state and csm$ctrlO) = 0 then /* state to change, 40 is */
do; /* is somewhat arbitrary */
call pxios1(mx$conout, char, copynum);
if controlP then
call pxios1(mx$lstout, char, ccb.mimic);
end;
count = count + 1;
end;
ccb.flag = ccb.flag and not cf$conout;
call write$change$mxq; /* possibly wake up PIN */
call wakeup(.ccb.cosleep); /* or user process */
end;
else
call write$change$mxq;
end;
if not more$in$file then
do;
num$purge$buf$chars = 0;
purge$ptr, inptr = 0ffffh;
call read$change$mxq;
if (ccb.state and csm$purging) <> 0 then
do;
ccb.state = ccb.state and not double(csm$purging);
call pxios1(mx$upstatus, 0, 0);
end;
call write$change$mxq;
end;
call wakeup(.ccb.usleep); /* wake up user process */
end purge;
abort: procedure;
dcl junk word;
do while drain$voutq(.junk); /* drain input queue */
end; /* may wake up user process */
call read$change$mxq;
ccb.state = ccb.state and not double(csm$abort);
call write$change$mxq;
call reset$file;
write$pending = false;
purge$ptr, inptr = 0ffffh;
num$purge$buf$chars = 0;
call wakeup(.ccb.usleep); /* wake up user process */
end abort;
initq: procedure(qdaddr) address;
dcl qdaddr address;
dcl ret boolean;
dcl iqd based qdaddr qd$structure;
call move(qnamsiz, .iqd.name, .qpb.name);
ret = mon2(m$makeq, qdaddr); /* 0ffh return = error */
ret = ret or mon2(m$openq, .qpb); /* ret = 0 if no error */
$if debug = 1
if ret then /* if debugging print error */
call error(@('Queue initialization error',0));
$endif
return(qpb.qaddr);
end initq;
dcl pd$pointer pointer; /* in RSP assembly interface */
dcl pd based pd$pointer (1) byte;
dcl pd$name lit '8';
dcl voutq$buf (32) byte;
dcl voutq qd$structure initial
(0,0,0, qf$hide + qf$keep, 'VOUTQ ',2,16,0,0,0,0,.voutq$buf);
dcl vinq$buf (64) byte; /* 64 bytes type ahead */
dcl vinq qd$structure initial
(0,0,0, qf$keep + qf$hide, 'VINQ ',1,64,0,0,0,0,.vinq$buf);
dcl vcmxq qd$structure initial
(0,0,0,qf$keep + qf$mx + qf$hide, 'VCMXQ ',0,1,0,0,0,0,0);
dcl qpb qpb$structure;
dcl dummy (1) byte data ('Z'); /* make constant segment non-zero to */
/* hex generation */
dcl fcb(36) byte initial (0,' ', '$$$');
/* initialization */
plmstart: procedure public;
dcl save$state word;
call mon1(m$errmode, 0ffh); /* don't display errors */
ccb$ptr.segment, sysdat$ptr.segment = rsplink;
sysdat$ptr.offset = 0;
ccb$ptr.offset = sd.ccb + copynum * size(ccb);
pd$pointer = mon4(m$getpd,0);
call movb(@pd(pd$name), @fcb(f$name), qnamsiz);
call move(4, .fcb(f$name + name$len), .vinq.name(4));
ccb.vinq = initq(.vinq);
call move(3, .fcb(f$name + name$len), .voutq.name(5));
ccb.voutq = initq(.voutq);
call move(3, .fcb(f$name + name$len), .vcmxq.name(5));
ccb.vcmxq = initq(.vcmxq);
call mon1(m$setcns, copynum); /* copynum is virtual console # */
fcb(f$drvusr) = sd.tempdisk + 1;
call write$change$mxq; /* write initial MX message */
call mon1(m$setprior, 200);
do forever;
if delete$flag then
call delete$file;
if (ccb.state and not double(csm$ctrlP + csm$ctrlO)) =
csm$buffered + csm$background then /* if ctrlO,background and */
call buffer; /* buffered, then sleep */
else if ( (ccb.state and not double(csm$ctrlO + csm$ctrlP))
and csm$purging) <> 0 then
call purge;
else if (ccb.state and csm$abort) <> 0 then
call abort;
if delete$flag then
call delete$file;
else
call read$voutq;
end;
end plmstart;
end vout;