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,631 @@
$title ('MP/M 1.1 Terminal Message Processor')
name tmp
cseg
;tmp:
;do;
;$include (copyrt.lit)
;/*
; Copyright (C) 1979, 1980
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
;
; Revised:
; 18 Jan 80 by Thomas Rolander
;*/
;$include (common.lit)
;$nolist
;$include (proces.lit)
;$nolist
;$include (queue.lit)
;$nolist
;$include (xdos.lit)
;$nolist
;$include (fcb.lit)
;$nolist
;$include (xdos.ext)
;$nolist
;$include (bdos.ext)
;$nolist
;$include (datapg.ext)
;$nolist
; xdos:
extrn xdos
; procedure (func,info) address external;
; declare func byte;
; declare info address;
; end xdos;
; mon1:
extrn mon1
; procedure (func,info) external;
; declare func byte;
; declare info address;
; end mon1;
; mon2:
extrn mon2
; procedure (func,info) byte external;
; declare func byte;
; declare info address;
; end mon2;
; open:
extrn open
; procedure (fcbadr) byte external;
; declare fcbadr address;
; end open;
; close:
extrn close
; procedure (fcbadr) byte external;
; declare fcbadr address;
; end close;
; readbf:
extrn readbf
; procedure (fcbadr) byte external;
; declare fcbadr address;
; end readbf;
; setdma:
extrn setdma
; procedure (dmaadr) external;
; declare dmaadr address;
; end setdma;
; co:
extrn co
; procedure (char) external;
; declare char byte;
; end co;
; ci:
extrn ci
; procedure byte external;
; end ci;
; printb:
extrn printb
; procedure (msgadr) external;
; declare msgadr address;
; end printb;
; readbu:
extrn readbu
; procedure (bufferadr) external;
; declare bufferadr address;
; end readbu;
; crlf:
extrn crlf
; procedure external;
; end crlf;
; assign:
extrn assign
; procedure (name$adr) byte external;
; declare name$adr address;
; end assign;
dseg
;/*
; TMP Data Segment
;*/
; declare rlr address external;
extrn rlr
; declare rlrpd based rlr process$descriptor;
; declare ver (1) byte external;
extrn ver
; declare cli$lqcb queuehead external;
extrn clilqcb
; declare subflgadr address;
subflgadr:
ds 2
; declare subflg based subflgadr (1) byte;
cseg
; declare cli$name (8) byte data ('c'+80h,'li ');
cliname:
db 'c'+80h,'li '
; declare submit$fcb (16) byte data (1,'$$$ SUB',
; 0,0,0,0);
submitfcb:
db 1
db '$$$ SUB'
db 0,0,0,0
dskerr:
db 'Disk error during submit file read.'
db '$'
;/*
; tmp:
;*/
; tmp:
tmp:
public tmp
LXI H,0FF4CH
DAD SP
SPHL
; procedure reentrant public;
; declare buf(129) byte;
; declare fcb fcb$descriptor;
; declare submit$flag byte;
; declare console byte;
; declare i byte;
; declare ret byte;
; declare CLIQ (2) address;
; declare pname (10) byte;
; console = rlrpd.console;
LXI B,0EH
LHLD RLR
DAD B
MOV A,M
LXI H,0A3H ; CONSOLE
DAD SP
MOV M,A
; subflgadr = xdos (system$data$adr,0) + 128;
MVI C,9AH
CALL XDOS
LXI D,80H
DAD D
SHLD SUBFLGADR
; subflg(console) = false;
LXI H,0A3H ; CONSOLE
DAD SP
MOV C,M
MVI B,0
LHLD SUBFLGADR
DAD B
MVI M,0H
; CLIQ(0) = .cli$lqcb;
LXI B,CLILQCB
LXI H,0A6H ; CLIQ
DAD SP
MOV M,C
INX H
MOV M,B
; CLIQ(1) = .buf;
LXI H,0H ; BUF
DAD SP
XCHG
LXI H,0A8H ; CLIQ+2H
DAD SP
MOV M,E
INX H
MOV M,D
; submit$flag = false;
LXI H,0A2H ; SUBMITFLAG
DAD SP
MVI M,0H
; pname(0) = console;
LXI H,0A3H ; CONSOLE
DAD SP
MOV A,M
LXI H,0AAH ; PNAME
DAD SP
MOV M,A
; call move (8,.cli$name,.pname(1));
INX H
XCHG
LXI B,CLINAME
MVI L,8H
LDAX B
STAX D
INX B
INX D
DCR L
JNZ $-5H
; pname(9) = 0;
XCHG
MOV M,E
; call set$dma (.buf(1));
LXI H,1H ; BUF+1H
DAD SP
MOV B,H
MOV C,L
;
; Temporarily swap stack pointers to avoid TMP process
; descriptor destruction.
;
lxi h,00a2h
dad sp
sphl
CALL SETDMA
; ret = xdos (attach,0);
MVI C,92H
CALL XDOS
; call print$b (.ver);
LXI B,VER
CALL PRINTB
; ret = xdos (detach,0);
MVI C,93H
CALL XDOS
lxi h,-00a2h
dad sp
sphl
; do forever;
@17:
; ret = xdos (attach,0);
MVI C,92H
CALL XDOS
; call crlf;
CALL CRLF
; i = rlrpd.disk$slct and 0fh;
LXI B,16H
LHLD RLR
DAD B
MOV A,M
PUSH PSW
ANI 0FH
; if (i:=i-10) < 15 then
SUI 10
JC @TMP0
; call co ('1');
PUSH PSW
MVI C,'1'
CALL CO
POP PSW
SUI 10
; call co (i + 10 + '0');
@TMP0:
ADI 10+'0'
MOV C,A
CALL CO
; call co (shr(rlrpd.disk$slct,4) + 'A');
POP PSW
ANI 0f8h
RAR
RAR
RAR
RAR
ADI 41H
MOV C,A
CALL CO
; call co ('>');
MVI C,3EH
CALL CO
; buf(0) = 100;
LXI H,0H ; BUF
DAD SP
MVI M,100
; if not submit$flag then
LXI H,0A2H ; SUBMITFLAG
DAD SP
MOV A,M
CMA
RAR
JNC @1
; do;
; if subflg(console) then
LXI H,0A3H ; CONSOLE
DAD SP
MOV C,M
MVI B,0
LHLD SUBFLGADR
DAD B
MOV A,M
RAR
JNC @2
; do;
; call move (16,.submit$fcb,.fcb.et);
LXI H,81H ; FCB
DAD SP
XCHG
LXI B,SUBMITFCB
MVI L,10H
LDAX B
STAX D
INX B
INX D
DCR L
JNZ $-5H
; fcb.fn(1) = console + '0';
MVI A,30H
LXI H,0A3H ; CONSOLE
DAD SP
ADD M
LXI H,83H ; FCB+2H
DAD SP
MOV M,A
; if open (.fcb) <> 0ffh then
LXI H,81H ; FCB
DAD SP
MOV B,H
MOV C,L
CALL OPEN
INR A
JZ @3
; do;
; submit$flag = true;
LXI H,0A2H ; SUBMITFLAG
DAD SP
MVI M,0FFH
; end;
@3:
; subflg(console) = false;
LXI H,0A3H ; CONSOLE
DAD SP
MOV C,M
MVI B,0
LHLD SUBFLGADR
DAD B
MOV M,B
; end;
@2:
; end;
; if submit$flag then
LXI H,0A2H ; SUBMITFLAG
DAD SP
MOV A,M
RAR
JNC @6
; do;
@1:
; use buffer area as temporary stack
lxi h,0081h
dad sp
sphl
; if mon2 (11,0) then
MVI C,0BH
CALL MON2
RAR
JNC @5
; do;
; ret = ci;
CALL CI
; call mon1 (19,.fcb);
; submit$flag = false;
; end;
lxi h,-0081h
dad sp
sphl
JMP @10A
@5:
lxi h,-0081h
dad sp
sphl
; else
; do;
; fcb.nr = fcb.rc - 1;
LXI H,90H ; FCB+0FH
DAD SP
MOV A,M
DCR A
LXI H,0A1H ; FCB+20H
DAD SP
MOV M,A
; if readbf (.fcb) = 0ffh then
LXI H,81H ; FCB
DAD SP
MOV B,H
MOV C,L
CALL READBF
INR A
JNZ @7
; do;
; submit$flag = false;
call endsubmit
; call mon1 (19,.fcb); /* delete file */
LXI H,81H ; FCB
DAD SP
XCHG
MVI C,13H
CALL MON1
; call print$b (.(
LXI B,dskerr
CALL PRINTB
; 'Disk error during submit file read.','$'));
; call crlf;
CALL CRLF
; end;
JMP @6
@7:
; else
; do;
; i = 2;
LXI H,2H ; BUF+2H
DAD SP
; do while buf(i) <> 0;
@7A:
mov a,m
ora a
jz @7B
mov c,a
; call co (.buf(i));
push h
CALL CO
pop h
; i = i + 1;
inx h
; end;
jmp @7A
; call co (0dh);
@7B:
mvi c,0dh
call co
JMP @9
; end;
; end;
; end;
; if not submit$flag then
; do;
@6:
; call read$bu (.buf);
LXI H,0H ; BUF
DAD SP
MOV B,H
MOV C,L
;
; The following stack swap is done to prevent destruction
; of the TMP process descriptor by the stack. The stack used
; during read$bu overlays the TMP fcb and the end of the
; line buffer. Note that the line buffer length is reduced
; from 128 to 100 bytes.
;
lxi h,00a2h
dad sp
sphl
CALL READBU
lxi h,-00a2h
dad sp
sphl
; end;
@9:
; if (buf(1) <> 0) and
LXI H,1H ; BUF+1H
DAD SP
MOV A,M
ORA A
JZ @10
MOV B,A
INX H
MOV A,M
CPI ';'
JZ @10
MOV C,A
; (buf(2) <> ';') then
; do;
; if (buf(1) = 2) and (buf(3) = ':') then
MOV A,B
CPI 2
JNZ @11
INX H
MOV A,M
CPI ':'
JNZ @11
; do;
; i = (buf(2) and 101$1111b) - 'A';
MVI A,5FH
ANA C
SUI 'A'
; if i < 16
CPI 10H
JNC @13
; then call mon1 (14,i);
MOV E,A
MVI C,0EH
CALL MON1
; end;
JMP @13
@11:
; else
; do;
; buf(buf(1)+2) = 0;
LXI H,1H ; BUF+1H
DAD SP
MOV C,M
MVI B,0
LXI H,2H ; BUF+2H
DAD SP
DAD B
MVI M,0H
; call co (0ah);
MVI C,0AH
CALL CO
; buf(0) = rlrpd.disk$slct;
LXI B,16H
LHLD RLR
DAD B
MOV A,M
LXI H,0H ; BUF
DAD SP
MOV M,A
; buf(1) = console;
XCHG
LXI H,0A3H ; CONSOLE
DAD SP
MOV A,M
INX D
STAX D
; ret = assign (.pname);
LXI H,0AAH ; PNAME
DAD SP
MOV B,H
MOV C,L
CALL ASSIGN
; ret = xdos (write$queue,.CLIQ);
LXI H,0A6H ; CLIQ
DAD SP
XCHG
MVI C,8BH
CALL XDOS
; end;
@13:
; end;
@10:
; if submit$flag then
LXI H,0A2H ; SUBMITFLAG
DAD SP
MOV A,M
RAR
JNC @17
; do;
; if fcb.nr = 1 then
dcx h
MOV A,M
DCR A
JNZ @15
@10A:
; do;
; submit$flag = false;
; call mon1 (19,.fcb); /* delete file */
LXI H,81H ; FCB
DAD SP
XCHG
MVI C,13H
CALL MON1
call endsubmit
; end;
JMP @17
@15:
; else
; do;
; fcb.rc = fcb.rc - 1;
LXI H,90H ; FCB+0FH
DAD SP
DCR M
; call close (.fcb);
LXI H,81H ; FCB
DAD SP
MOV B,H
MOV C,L
CALL CLOSE
; end;
; end;
; end;
JMP @17
; end tmp;
;end tmp;
endsubmit:
; submit$flag = false;
LXI H,0A2H+2 ; SUBMITFLAG
DAD SP
mvi m,0
; /* free drive */
; call mon1 (39,0ffffh);
mvi c,39
lxi d,0ffffh
jmp mon1
END