mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 01:14:21 +00:00
631 lines
9.4 KiB
NASM
631 lines
9.4 KiB
NASM
$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
|
||
|