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,451 @@
$title ('MP/M 1.1 Parse Filename')
name parse
cseg
;parse:
;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 (queue.lit)
;$nolist
;$include (xdos.lit)
;$nolist
;$include (xdos.ext)
;$nolist
; readq:
extrn readq
; procedure (uqcbadr) byte external;
; declare uqcbadr address;
; end readq;
; writeq:
extrn writeq
; procedure (uqcbadr) byte external;
; declare uqcbadr address;
; end writeq;
; xdos:
extrn xdos
; procedure (func,info) address external;
; declare func byte;
; declare info address;
; end xdos;
dseg
;/*
; Parse Queue Data Segment
;*/
; declare parse$cqcb structure (cqueue,pdadr address) public
; initial (0,'MXParse ',0,1);
public parsecqcb
parsecqcb:
dw $-$ ; ql
db 'MXParse ' ; name
dw 0 ; msglen
dw 1 ; nmbmsgs
dw $-$ ; dqph
dw $-$ ; nqph
dw $-$ ; msgin
dw $-$ ; msgout
dw $-$ ; msgcnt
dw $-$ ; pdadr
; declare parse$mutex address public
; initial (.parse$cqcb);
parsemutex:
public parsemutex
dw parsecqcb ; pointer
cseg
del:
db 0dh,' =.:<>_[],'
; /*
; parse:
; */
parse:
; parse:
; procedure (pcb$adr) address;
dseg
; declare pcb$adr address;
pcbadr: ds 2
; declare pcb based pcb$adr structure (
; filename$adr address,
; fcb$adr address );
; declare pcb$filename$adr address;
pcbfilenameadr:
ds 2
; declare pcb$fcb$adr address;
pcbfcbadr:
ds 2
; declare filename based pcb$filename$adr (1) byte;
filename equ pcbfilenameadr+1
; declare fcb based pcb$fcb$adr (1) byte;
fcb equ pcbfcbadr+1
; declare
; /* return conditions */
; endline literally '00000H',
; badfile literally '0FFFFH',
; /* useful literals */
; disk literally 'fcb(0)',
; fcbname literally '8', /* end of name */
; fcbtype literally '11', /* end of type field */
; fcbsize literally '16'; /* partial size of fcb */
; declare char byte; /* global temp for current char */
char: ds 1
; declare fnp byte; /* index into file name buffer */
fnp: ds 1
; declare fnlen byte;
fnlen: ds 1
cseg
; /* initialize local bases */
; pcb$filename$adr = pcb.filename$adr;
LDAX B
MOV L,A
INX B
LDAX B
MOV H,A
SHLD PCBFILENAMEADR
; pcb$fcb$adr = pcb.fcb$adr;
; /* initialize file control block to empty */
INX B
LDAX B
MOV L,A
INX B
LDAX B
MOV H,A
SHLD PCBFCBADR
; char = ' ';
LXI H,CHAR
MVI M,20H
; fnlen = 0;
LXI H,FNLEN
MVI M,0H
; fnp = -1;
DCX H
MVI M,0FFH
; do while fnlen < fcbsize-1;
@24:
LDA FNLEN
CPI 0FH
JNC @25
; if fnlen = fcbtype then char = 0;
SUI 0BH
JNZ @4
LXI H,CHAR
MOV M,A
@4:
; call putchar;
CALL PUTCHAR
; end;
JMP @24
@25:
; disk = 0;
; /* scan next name */
LHLD PCBFCBADR
MVI M,0H
; do forever;
@26:
; /* deblank command buffer */
; call gnc;
CALL GNC ; char left in A
; do while char = ' ';
@28:
CPI 20H
JZ @26
; call gnc;
; end;
; if delimiter then return badfile;
CALL DELIMITER
RAR
JC @8A
; fnlen = 0;
LXI H,FNLEN
MVI M,0H
; do while not delimiter;
@30:
CALL DELIMITER
RAR
JC @31
; if fnlen >= fcbname then /* error, file name too long */
LDA FNLEN
CPI 8H
JC @6
; return badfile;
@8A:
LXI H,0FFFFH
RET
@6:
; if char = '*' then call fillq(fcbname); else call putchar;
LDA CHAR
CPI 2AH
JNZ @7
MVI C,8H
CALL FILLQ
JMP @8
@7:
CALL PUTCHAR
@8:
; call gnc;
CALL GNC
; end;
JMP @30
@31:
; /* check for disk name */
; if char = ':' then
LDA CHAR
CPI 3AH
JNZ @9
; do;
; if not (disk = 0 and fnlen = 1) then
LHLD PCBFCBADR
MOV A,M
ORA A
JNZ @8A
LDA FNLEN
DCR A
JNZ @8A
; return badfile;
; /* must be a disk name */
; if (disk := fcb(1) - 'A' + 1) > 26
; /* invalid disk name */
LHLD PCBFCBADR
INX H
MOV A,M
SUI 41H
INR A
DCX H
MOV M,A
CPI 27
JNC @8A
; then return badfile;
; /* valid disk name replace space in name */
; else fcb(fnlen) = ' ';
LHLD FNLEN
MVI H,0
XCHG
LHLD PCBFCBADR
DAD D
MVI M,20H
; end;
JMP @26
@9:
; else
; do;
; /* char is not ':', so file name is set. scan remainder */
; /* at least one char scanned */
; fnlen = fcbname;
LXI H,FNLEN
MVI M,8H
; if char = '.' then /* scan file type */
CPI 2EH
JNZ @14
; do;
; call gnc;
CALL GNC
; do while not delimiter;
@32:
CALL DELIMITER
RAR
JC @33
; if fnlen >= fcbtype then
LDA FNLEN
CPI 0BH
JC @15
; /* error, type field too long */
; return badfile;
LXI H,0FFFFH
RET
@15:
; if char = '*'
LDA CHAR
CPI 2AH
JNZ @16
; then call fillq(fcbtype);
MVI C,0BH
CALL FILLQ
JMP @17
@16:
; else call putchar;
CALL PUTCHAR
@17:
; call gnc;
CALL GNC
; end;
JMP @32
@33:
LDA CHAR
; end;
@14:
; if char = 0dh
CPI 0DH
LXI H,0000H
; then return endline;
RZ
; else return .filename(fnp);
LHLD FNP
MVI H,0
XCHG
LHLD PCBFILENAMEADR
DAD D
RET
; end;
; end; /* of forever */
; end parse;
; gnctran:
gnctran:
; procedure(b) byte;
; declare b byte;
; if b < ' ' then return 0dh; /* all non-graphics */
MOV A,C
CPI 20H
MVI A,0DH
RC
; /* translate alpha to upper case */
; if b >= 'a' and b <= 'z' then
MOV A,C
CPI 'a'
RC
CPI 'z'+1
RNC
ANI 5FH
RET
; b = b and 101$1111b; /* upper case */
; return b;
; end gnctran;
; gnc:
gnc:
; procedure;
; char = gnctran(filename(fnp := fnp + 1));
LXI H,FNP
INR M
MOV C,M
MVI B,0
LHLD PCBFILENAMEADR
DAD B
MOV C,M
CALL GNCTRAN
STA CHAR
; end gnc;
RET
; delimiter:
delimiter:
; procedure byte;
; declare i byte;
; declare del(*) byte data
; (0dh,' =.:<>_[],');
; do i = 0 to last(del);
MVI C,11
LXI D,DEL
LXI H,CHAR
@20:
; if char = del(i) then return true;
LDAX D
SUB M
MVI A,0FFH
RZ
INX D
DCR C
JNZ @20
; end;
; return false;
XRA A
RET
; end delimiter;
; putchar:
putchar:
; procedure;
; fcb(fnlen:=fnlen+1) = char;
; /* can check here for ambig ref's "char = '?'" */
LXI H,FNLEN
INR M
MOV C,M
MVI B,0
LHLD PCBFCBADR
DAD B
LDA CHAR
MOV M,A
; end putchar;
RET
; fillq:
fillq:
; procedure(len);
; /* fill current name or type with question marks */
; declare len byte;
; char = '?'; /* question mark */
LXI H,CHAR
MVI M,3FH
; do while fnlen < len;
@22:
LDA FNLEN
CMP C
RNC
; call putchar;
PUSH B
CALL PUTCHAR
POP B
; end;
JMP @22
; end fillq;
;/*
; parse$filename:
;*/
; parse$filename:
parsefilename:
PUSH B
; procedure (pcb$adr) address reentrant public;
public parsefilename
; declare pcb$adr address;
; declare nxt$chr$adr address;
; declare ret byte;
; ret = xdos (read$queue,.parse$mutex);
LXI B,PARSEMUTEX
CALL READQ
; nxt$chr$adr = parse (pcb$adr);
POP B
CALL PARSE
PUSH H
; ret = xdos (write$queue,.parse$mutex);
LXI B,PARSEMUTEX
CALL WRITEQ
; return nxt$chr$adr;
POP H
RET
; end parse$filename;
;end parse;
END