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

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,651 @@
; Support for CP/M 2.0 added 5 Sept 79 - J R Pierce
;HARD DISK VERSION 8-26-79
; BIOS FOR MICRO-2 COMPUTER
;
;THE IOBYTE IS IMPLEMENTED
;
;INTERRUPTS ARE NOT IMPLEMENTED
;
maclib diskdef
;
;THIS VERSION CONTAINS DISK DRIVERS FOR THE DIGITAL SYSTEMS
;FDC-3 CONTROLLER BOARD. THIS BOARD CAN HANDLE DOUBLE DENSITY
;
; NOTE : MSIZE DETERMINES WHERE THIS CBIOS IS LOCATED
MSIZE EQU 64 ;CP/M VERSION MEMORY SIZE IN KILOBYTES
VERS EQU 20
ndisks equ 2
ram$top equ msize*1024
bios equ ram$top-6*256
bdos equ bios-0e00h
ccp equ bdos-0800h
warm$boot equ ccp-0080h
org bios
; WE WILL USE A SCRATCH AREA STARTING AT 40H
SCRAT EQU 40H ;START OF SCRATCH AREA
TRACK EQU SCRAT ;CURRENT TRACK ON DRIVE 0
TRAK1 EQU TRACK+1 ;CURRENT TRACK ON DRIVE 1
TRAK2 EQU TRAK1+1
TRAK3 EQU TRAK2+1
SECTOR EQU TRAK3+1 ;CURRENTLY SELECTED SECTOR
DMAAD EQU SECTOR+1 ;CURRENT DMA ADDRESS
DISKNO EQU DMAAD+2 ;CURRENT DISK NUMBER
DUMMY EQU DISKNO+1 ;MUST BE 0 FOR DOUBLE ADD
ERRORS EQU DUMMY+1
PORT EQU 4AH
PORTOUT EQU PORT+1
DENSITY EQU PORTOUT+1
;
IOBYTE EQU 3
;
;SET UP INPUT OUTPUT PORTS
DATA EQU 40H
STATUS EQU DATA+1
DATA1 EQU 48H
STATUS1 EQU DATA1+1
DATA2 EQU 50H
STATUS2 EQU DATA2+1
PARALLEL EQU 61H
;
;
; JUMP VECTOR FOR INDIVIDUAL SUBROUTINES
JMP WARMBOOT ;COLD START
WBOTE:
JMP WBOOT ;WARM START
JMP CONST ;CONSOLE STATUS
JMP CONIN ;CONSOLE CHARACTER IN
JMP CONOUT ;CONSOLE CHARACTER OUT
JMP LIST ;LIST CHARACTER OUT
JMP PUNCH ;PUNCH CHARACTER OUT
JMP READER ;READER CHARACTER OUT
JMP HOME ;MOVE HEAD TO HOME POSITION
JMP SELDSK ;SELECT DISK
JMP SETTRK ;SET TRACK NUMBER
JMP SETSEC ;SET SECTOR NUMBER
JMP SETDMA ;SET DMA ADDRESS
JMP READ ;READ DISK
JMP WRITE ;WRITE DISK
jmp lstat ; list status routine
jmp sectran ; logical->physical sector mapping
;THE WARM BOOT ROUTINE EXPECTS TO FIND THE LOG ON MESSAGE HERE
;SINCE THERE WAS NOT ENOUGH ROOM IN IT
DW 0D0AH ;CR,LF
DB MSIZE/10+'0',MSIZE MOD 10+'0'
DB 'k CP/M Vers'
DB VERS/10+'0','.',VERS MOD 10+'0'
DB 0
;
; INDIVIDUAL SUBROUTINES TO PERFORM EACH FUNCTION
;
WBOOT:
;READ IN TRACK 0 SECTOR 2 WHICH WILL DO THE REST OF THE WARM START
;
LXI SP,80H ;USE SPACE BELOW BUFFER FOR STACK
MVI C,0 ;SELECT DISK 0
CALL SELDSK
CALL HOME ;GO TO TRACK 00
;
;SET SINGLE DENSITY
LDA PORT
ANI 0F7H
STA PORT
;SET DMA ADDRESS TO 80 BELOW START OF CCP
LXI B,WARMBOOT
CALL SETDMA
MVI C,2
CALL SETSEC
;NOW READ
CALL READ
ORA A ;ANY ERRORS?
JNZ WBOOT ;RETRY THE ENTIRE BOOT IF AN ERROR OCCURS
;
;
JMP WARMBOOT+3 ;GO FINISH THE WARM START
;I/O HANDLERS
;
CONST: CALL CONS
ORA A
RZ
MVI A,0FFH
RET
;
CONS:
CALL condsptch
DW TTYST
DW CRTST
DW BATST
DW UC1ST
;
CONIN:
CALL condsptch
DW TTYIN
DW CRTIN
DW BATIN
DW UC1IN
;
CONOUT:
CALL condsptch
DW TTYOUT
DW CRTOUT
DW BATOUT
DW UC1OUT
;
LIST:
LDA IOBYTE
RLC! RLC
CALL IODSPRLC
DW TTYOUT
DW CRTOUT
DW LPTOUT
DW UL1OUT
lstat: ; Dummy Routine
xra a ! ret
PUNCH:
LDA IOBYTE
RRC! RRC! RRC
CALL IODISPATCH
DW TTYOUT
DW PTPOUT
DW UP1OUT
DW UP2OUT
;
READER:
LDA IOBYTE
RRC
CALL IODISPATCH
DW TTYIN
DW PTRIN
DW UR1IN
DW UR2IN
;
condsptch:
lda io$byte
IODSPRLC:
RLC
IODISPATCH:
ANI 6H
XTHL ;GET TABLE ADDRESS
PUSH D
MOV E,A
MVI D,0
DAD D
MOV A,M
INX H
MOV H,M
MOV L,A
POP D
XTHL
RET
;
;
PORT0ST: ;CONSOLE STATUS, RETURN 0FFH IF CHARACTER READY, 00H IF NOT
IN STATUS
ANI 2
RZ
MVI A,0FFH
RET
;
;
PORT0IN: ;CONSOLE CHARACTER INTO REGISTER A
CALL PORT0ST
JZ PORT0IN
IN DATA
ANI 7FH ;STRIP PARITY BIT
RET
;
;
PORT0OUT: ;CONSOLE CHARACTER OUTPUT FROM REGISTER C
in status
rrc
jnc port0out
MOV A,C
OUT DATA
RET
;
;
PORT1ST:
IN STATUS1
ANI 2
RZ
MVI A,0FFH
RET
;
PORT1IN:
CALL PORT1ST
JZ PORT1IN
IN DATA1
ANI 7FH ;STRIP PARITY BIT
RET
;
PORT1OUT: ;LIST CHARACTER FROM REGISTER C
IN STATUS1
RRC
JNC PORT1OUT
MOV A,C ;CHARACTER TO REGISTER A
OUT DATA1
RET ;NULL SUBROUTINE
;
PORT2ST:
IN STATUS2
ANI 2
RZ
MVI A,0FFH
RET
;
PORT2IN:
CALL PORT2ST
JZ PORT2IN
IN DATA2
ANI 7FH
RET
;
PORT2OUT:
IN STATUS2
RRC
JNC PORT2OUT
MOV A,C
OUT DATA2
RET
;
;
PORTPOUT:
IN PARALLEL
ANI 80H
JNZ PORTPOUT
MOV A,C
OUTIT:
ORI 80H
OUT PARALLEL
ANI 7FH
OUT PARALLEL
ORI 80H
OUT PARALLEL
RET
;
;CP/M PHYSICAL DEVICE TO MICRO2 PHYSICAL DEVICE MAP
;
TTYST EQU PORT0ST
TTYIN EQU PORT0IN
TTYOUT EQU PORT0OUT
CRTST EQU PORT1ST
CRTIN EQU PORT1IN
CRTOUT EQU PORT1OUT
BATST EQU PORT2ST
BATIN EQU PORT2IN
BATOUT EQU PORT2OUT
UC1ST EQU PORT0ST
UC1IN EQU PORT0IN
UC1OUT EQU PORT0OUT
LPTOUT EQU PORTPOUT
UL1OUT EQU PORT2OUT
PTPOUT EQU PORT2OUT
PTRIN EQU PORT2IN
UP1OUT EQU PORT0OUT
UP2OUT EQU PORT1OUT
UR1IN EQU PORT0IN
UR2IN EQU PORT1IN
;
;
COMAND1 EQU 80H
STAT EQU 80H
HADDR EQU 81H
LADDR EQU 82H
COMAND2 EQU 83H
;
;
; I/O DRIVERS FOR THE DISK FOLLOW
;
HOME: ;MOVE TO THE TRACK O0 POSITION OF CURRENT DRIVE
CALL HEADLOAD
; H,L POINT TO WORD WITH TRACK FOR SELECTED DISK
HOMEL:
MVI M,00 ;SET CURRENT TRACK PTR BACK TO 0
IN STAT ;READ FDC STATUS
ANI 4 ;TEST TRACK 0 BIT
RZ ;RETURN IF AT 0
STC ;DIRECTION=OUT
CALL STEP ;STEP ONE TRACK
JMP HOMEL ;LOOP
;
SELDSK: ;SELECT DISK GIVEN BY REGISTER C
;MAKE SURE DUMMY IS 0 (FOR USE IN DOUBLE ADD TO H,L)
cpi ndisks ! jnc bad$drive
XRA A
STA DUMMY
MOV A,C
ANI 07H ;GET ONLY DISK SELECT BITS
STA DISKNO
MOV C,A
MOV B,A
;GET DENSITY OF SELECTED DRIVE
;B HAS DRIVE NUMBER FROM 0-7
LDA DENSITY
;DENSITY BIT 0= DENSITY FOR DRIVE A, BIT 1=DRIVE B ETC
;A 1 MEANS DOUBLE DENSITY
GETDR:
DCR B
RRC
JP GETDR ;NOT AT PROPER BIT YET
JC SETDOB
SETSING:
LXI D,SINGTAB
lxi h,stagger
JMP OVERBOTH
SETDOB:
LXI D,DOBTAB
lxi h,0 ; no stagger table
MOV A,C
;SET THE CHANGE DENSITY BIT
ORI 08
MOV C,A
OVERBOTH:
lda port ! ani 0f0h ! ora c ! sta port
push h ; save stagger table address
lhld diskno
dad h ! dad h ! dad h ! dad h
lxi b,dpbase+10
dad b ; points HL to right disk parameter table
mov m,e ! inx h ! mov m,d ; save diskdef address
lxi b,-10 ; point back to tran table address
dad b
pop d ; get current tran table
mov m,d ! dcx h ! mov m,e ; store its address
; HL now points to appropriate drive parameter block
RET
bad$drive: ; here if invalid drive code
lxi h,0 ! ret ; zero means select error
SETTRK: ;SET TRACK GIVEN BY REGISTER C
CALL HEADLOAD
;H,L REFERENCE CORRECT TRACK INDICATOR ACCORDING TO
;SELECTED DISK
MOV A,C ;DESIRED TRACK
CMP M
RZ ;WE ARE ALREADY ON THE TRACK
SETTKX:
CALL STEP ;STEP TRACK-CARRY HAS DIRECTION
;STEP WILL UPDATE TRACK INDICATOR
MOV A,C
CMP M ;ARE WE WHERE WE WANT TO BE
JNZ SETTKX ;NOT YET
;HAVE STEPPED ENOUGH
SEEKRT:
;DELAY 10 MSEC FOR FINAL STEP TIME AND HEAD SETTLE TIME
;THE DELAY ROUTINE DELAYS .5 MILLISECOND
MVI A,20D
CALL DELAY
RET ;END OF SETTRK ROUTINE
;
DELAY: ;ROUTINE TO DELAY C(A) .5 MILLISECONDS
PUSH B
DELAY2:
MVI C,086H ;ADJUST FOR .5 MSEC LOOP DELAY
;THIS IS THE VALUE FOR OUR IMSAI
LDXA:
DCR C
JNZ LDXA ;LOOP 1 MSEC
DCR A
JNZ DELAY2
POP B
RET ;END OF DELAY ROUTINE
;
sectran:
mov h,b ! mov l,c ! inx h ; in case we aren't using translation
mov a,d ! ora e ! rz ; we return logical+1
xchg ! dad b ! mov l,m ! mvi h,0 ; else fetch physical
ret ; back to bdos
SETSEC: ;SET SECTOR GIVEN BY REGISTER C
MOV A,C
STA SECTOR
RET
;
SETDMA: ;SET DMA ADDRESS GIVEN BY REGISTERS B AND C
MOV L,C ;LOW ORDER ADDRESS
MOV H,B ;HIGH ORDER ADDRESS
SHLD DMAAD ;SAVE THE ADDRESS
RET
;
;
READ: ;PERFORM READ OPERATION.
;THIS IS SIMILAR TO WRITE, SO SET UP READ COMMAND AND USE
;COMMON CODE IN WRITE
MVI B,040H ;SET READ FLAG
JMP WAITIO ;TO PERFORM THE ACTUAL I/O
;
WRITE: ;PERFORM A WRITE OPERATION
MVI B,080H ;SET WRITE COMMAND
;
WAITIO:
;ENTER HERE FROM READ AND WRITE TO PERFORM THE ACTUAL I/O
;OPERATION. RETURN A 00H IN REGISTER A IF THE OPERATION COMPLETES
;PROPERLY, AND 01H IF AN ERROR OCCURS DURING THE READ OR WRITE
;
;IN THIS CASE, WE HAVE SAVED THE DISK NUMBER IN 'DISKNO'
; THE TRACK NUMBER IN 'TRACK'
; THE SECTOR NUMBER IN 'SECTOR'
; THE DMA ADDRESS IN 'DMAAD'
;B STILL HAS R/W FLAG
MVI A,10D ;SET ERROR COUNT
STA ERRORS ;RETRY SOME FAILURES 10 TIMES
;BEFORE GIVING UP
TRYAGN:
PUSH B
CALL HEADLOAD
;H,L POINT TO TRACK BYTE FOR SELECTED DISK
POP B
MOV C,M
; DECIDE WHETHER TO ALLOW DISK WRITE PROCOMPENSTATION
MVI A,39D ;PRECOMP SHOULD BE INHIBITED ON TRACKS
;0-39
CMP C
JC ALLOWIT
;INHIBIT PRECOMP
MVI A,10H
ORA B
MOV B,A ;GOES OUT ON THE SAME PORT AS READ/WRITE
ALLOWIT:
LHLD DMAAD ;GET BUFFER ADDRESS
PUSH B ;B HAS R/W CODE C HAS TRACK
DCX H ;SAVE AND REPLACE 3 BYTES BELOW
;BUF WITH TRACK,SECTOR,ADDRESS MARK
MOV E,M
;FIGURE CORRECT ADDRESS MARK
LDA PORT
ANI 08H
MVI A,0FBH
JZ SIN
ANI 0FH ;WAS DOUBLE
;0BH IS DOUBLE DENSITY
;0FBH IS SINGLE DENSITY
SIN:
MOV M,A
;FILL IN SECTOR
DCX H
MOV D,M
LDA SECTOR ;NOTE THAT INVALID SECTOR NUMBER
;WILL RESULT IN HEAD UNLOADED
;ERROR, SO DONT CHECK
MOV M,A
;FILL IN TRACK
DCX H
POP B
MOV A,C
MOV C,M
MOV M,A
MOV A,H ;SET UP FDC DMA ADDRESS
OUT HADDR ;HIGH BYTE
MOV A,L
OUT LADDR ;LOW BYTE
MOV A,B ;GET R/W FLAG
OUT COMAND1 ;START DISK READ/WRITE
RWWAIT: IN STAT ;READ FDC STATUS
ANI 088H ;TEST FOR HEAD UNLOAD OR IOF
JZ RWWAIT
MOV M,C ;RESTORE 3 BYTES BELOW BUF
INX H
MOV M,D
INX H
MOV M,E
IN STAT ;TEST FOR ERRORS
ANI 0F0H
RZ ;A WILL BE 0 IF NO ERRORS
ERRTN:
;COME HERE ON ERROR FROM DISK
PUSH PSW ;SAVE ERROR CONDITION
;CHECK FOR 10 ERRORS
LXI H,ERRORS
DCR M
JNZ REDO ;NOT TEN YET. DO A RETRY
;WE HAVE TOO MANY ERRORS. PRINT OUT HEX NUMBER FOR LAST
;RECEIVED ERROR TYPE. CPM WILL PRINT PERM ERROR MESSAGE.
POP PSW ;GET CODE
RRC
RRC
RRC
RRC
;MAKE IT ASCII
ORI 030H
STA BDOS+0A4H
;SET ERROR RETURN FOR OPERATING SYSTEM
MVI A,1
RET
REDO:
;B STILL HAS READ/WRITE FLAG
POP PSW ;GET ERROR CODE
ANI 0E0H ;RETRY IF NOT TRACK ERROR
JNZ TRYAGN ;
;WAS A TRACK ERROR SO NEED TO RESEEK
PUSH B ;SAVE READ/WRITE INDICATOR
;FIGURE OUT THE DESIRED TRACK
LXI D,TRACK
LHLD DISKNO ;SELECTED DISK
DAD D ;POINT TO CORRECT TRACK INDICATOR
MOV A,M ;DESIRED TRACK
PUSH PSW ;SAVE IT
CALL HOME
POP PSW
MOV C,A
CALL SETTRK
POP B ;GET READ/WRITE INDICATOR
JMP TRYAGN
;
;
;
STEP: ;STEP HEAD OUT TOWARDS ZERO
;IF CARRY IS SET; ELSE
;STEP IN
; H,L POINT TO CORRECT TRACK INDICATOR WORD
JC OUTX
INR M ;INCREMENT CURRENT TRACK BYTE
MVI A,04H ;SET DIRECTION = IN
DOSTEP:
ORI 2
OUT COMAND1 ;PULSE STEP BIT
ANI 0FDH
OUT COMAND1 ;TURN OFF PULSE
;THE FDC-2 HAD A STEPP READY LINE. THE FDC-3 RELIES ON
;SOFTWARE TIME OUT
MVI A,16D ;WAIT FOR STEP READY
;DELAY ROUTINE DELAYS FOR .5 MSEC TIMES THE CONTENTS OF REG A
CALL DELAY
RET
;
OUTX:
DCR M ;UPDATE TRACK BYTE
XRA A
JMP DOSTEP
;
HEADLOAD:
;SELECT AND LOAD THE HEAD ON THE CORRECT DRIVE
LXI H,PORTOUT ;OLD SLECT INFO
MOV B,M
DCX H ;NEW SELECT INFO
MOV A,M
INX H
MOV M,A
OUT COMAND2 ;SELECT THE DRIVE
;SET UP H.L TO POINT TO TRACK BYTE FOR SELECTED DISK
LXI D,TRACK
LHLD DISKNO
DAD D
;NOW CHECK FOR NEEDING A 35 MS DELAY
;IF WE HAVE CHANGED DRIVES OR IF THE HEAD IS UNLOADED
;WE NEED0TO WAIT 35 MS FOR HEAD SETTLE
CMP B ;ARE WE ON THE SAME DRIVE AS BEFORE
JNZ NEEDDLY
;WE ARE ON THE SAME DRIVE
;IS THE HEAD LOADED?
IN STAT
ANI 80H
RZ ;ALREADY LOADED
NEEDDLY:
XRA A
OUT COMAND1 ;LOAD THE HEAD
;THE DELAY ROUTINE DELAYS FOR .5 MSEC
MVI A,70D
CALL DELAY
RET
;
; disks 2
dpbase:
dpe0: dw $-$, 0
dw 0, 0
dw dirbuf, $-$
dw csv0, alv0
dpe1: dw $-$, 0
dw 0, 0
dw dirbuf, $-$
dw csv1, alv1
dobtab:
; diskdef 0,1,58,,2048,256,128,128,2
dw 58
db 4,15,1
dw 255,127
db 192,0
dw 32,2
singtab:
; diskdef 1,1,26,6,1024,243,64,64,2
dw 26
db 3,7,0
dw 242,63
db 192,0
dw 16,2
stagger: ; Standard CP/M Stagger Table (Skew 6)
db 1,7,13,19,25
db 5,11,17,23
db 3,9,15,21
db 2,8,14,20,26
db 6,12,18,24
db 4,10,16,22
; endef
begdat:
dirbuf:
ds 128
alv0:
ds 32
csv0:
ds 32
alv1:
ds 32
csv1:
ds 32
enddat equ $
end


View File

@@ -0,0 +1,385 @@
$title('File Concatenation')
concat:
do;
$include (copyrt.lit)
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare start label;
declare jmp$to$start structure (
jmp$instr byte,
jmp$location address ) data (
0C3H,
.start-3);
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;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
system$reset:
procedure;
call mon1 (0,0);
end system$reset;
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
print$console$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$console$buffer;
open$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (15,fcb$address);
end open$file;
close$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (16,fcb$address);
end close$file;
delete$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
read$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (20,fcb$address);
end read$record;
write$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (21,fcb$address);
end write$record;
create$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (22,fcb$address);
end create$file;
set$DMA$address:
procedure (DMA$address);
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
parse:
procedure (pcb$adr) address;
declare pcb$adr address;
declare pcb based pcb$adr structure (
filename$adr address,
fcb$adr address );
declare pcb$filename$adr address;
declare pcb$fcb$adr address;
declare filename based pcb$filename$adr (1) byte;
declare fcb based pcb$fcb$adr (1) byte;
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 */
declare fnp byte; /* index into file name buffer */
declare fnlen byte;
gnctran:
procedure(b) byte;
declare b byte;
if b < ' ' then return 0dh; /* all non-graphics */
/* translate alpha to upper case */
if b >= 'a' and b <= 'z' then
b = b and 101$1111b; /* upper case */
return b;
end gnctran;
gnc:
procedure;
char = gnctran(filename(fnp := fnp + 1));
end gnc;
delimiter:
procedure byte;
declare i byte;
declare del(*) byte data
(0dh,' =.:<>_[],');
do i = 0 to last(del);
if char = del(i) then return true;
end;
return false;
end delimiter;
putchar:
procedure;
fcb(fnlen:=fnlen+1) = char;
/* can check here for ambig ref's "char = '?'" */
end putchar;
fillq:
procedure(len);
/* fill current name or type with question marks */
declare len byte;
char = '?'; /* question mark */
do while fnlen < len;
call putchar;
end;
end fillq;
/* initialize local bases */
pcb$filename$adr = pcb.filename$adr;
pcb$fcb$adr = pcb.fcb$adr;
/* initialize file control block to empty */
char = ' ';
fnlen = 0;
fnp = -1;
do while fnlen < fcbsize-1;
if fnlen = fcbtype then char = 0;
call putchar;
end;
disk = 0;
/* scan next name */
do forever;
/* deblank command buffer */
call gnc;
do while char = ' ';
call gnc;
end;
if delimiter then return badfile;
fnlen = 0;
do while not delimiter;
if fnlen >= fcbname then /* error, file name too long */
return badfile;
if char = '*' then call fillq(fcbname); else call putchar;
call gnc;
end;
/* check for disk name */
if char = ':' then
do;
if not (disk = 0 and fnlen = 1) then
return badfile;
/* must be a disk name */
if (disk := fcb(1) - 'A' + 1) > 26
/* invalid disk name */
then return badfile;
/* valid disk name replace space in name */
else fcb(fnlen) = ' ';
end;
else
do;
/* char is not ':', so file name is set. scan remainder */
/* at least one char scanned */
fnlen = fcbname;
if char = '.' then /* scan file type */
do;
call gnc;
do while not delimiter;
if fnlen >= fcbtype then
/* error, type field too long */
return badfile;
if char = '*'
then call fillq(fcbtype);
else call putchar;
call gnc;
end;
end;
if char = 0dh
then return endline;
else return .filename(fnp);
end;
end; /* of forever */
end parse;
declare pcb structure (
filename$adr address,
fcb$adr address );
declare nxt$chr$adr address;
declare old$nxt$chr$adr address at (.pcb.filename$adr);
declare char byte;
declare ret byte at (.char);
declare delim based nxt$chr$adr byte;
declare fcbin (33) byte;
declare fcbout (33) byte initial (
0,' ',' ',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare default$fcb (33) byte data (
0,' ',' ',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare nmb$sect literally '32';
declare buffer (nmb$sect) structure (
record (128) byte);
setup$output$file:
procedure;
pcb.filename$adr = .tbuff(1);
pcb.fcb$adr = .fcbout;
nxt$chr$adr = parse (.pcb);
if delim <> '=' then
do;
if nxt$chr$adr = 0 then
do;
call print$console$buffer (.(
'No input files specified','$'));
go to error;
end;
if nxt$chr$adr = 0ffffh then
do;
call print$console$buffer (.(
'Bad output file name','$'));
go to error;
end;
call print$console$buffer (.(
'A ''='' delimeter expected after output file name','$'));
go to error;
end;
call set$DMA$address (.buffer);
if open$file (.fcbout) <> 255 then
do;
call print$console$buffer (.(
'Destination file exists, delete (Y/N) ? ','$'));
char = read$console;
if (char <> 'y') and (char <> 'Y')
then call system$reset;
call crlf;
call delete$file (.fcbout);
end;
if create$file (.fcbout) = 255 then
do;
call print$console$buffer (.(
'Directory full','$'));
call system$reset;
end;
end setup$output$file;
setup$input$file:
procedure;
pcb.filename$adr = nxt$chr$adr + 1;
pcb.fcb$adr = .fcbin;
call move (33,.default$fcb,.fcbin);
if (nxt$chr$adr := parse (.pcb)) = 0ffffh then
do;
call print$console$buffer (.(
'Bad input file name','$'));
go to error;
end;
call set$DMA$address (.buffer);
if open$file (.fcbin) = 255 then
do;
call print$console$buffer (.(
'No such input file','$'));
go to error;
end;
end setup$input$file;
copy$file:
procedure;
declare (i,cnt) byte;
declare (ok,more$input) boolean;
more$input = true;
do while more$input;
cnt = 0;
ok = true;
do while ok;
call set$DMA$address (.buffer((cnt := cnt+1)-1));
ok = (read$record (.fcbin) = 0) and
(cnt <> nmb$sect);
end;
if (more$input := (cnt = nmb$sect))
then cnt = cnt - 1;
else cnt = cnt - 2;
do i = 0 to cnt;
call set$DMA$address (.buffer(i));
if write$record (.fcbout) <> 0 then
do;
call print$console$buffer (.(
'Disk write error','$'));
call system$reset;
end;
end;
end;
end copy$file;
/*
F i l e C o n c a t e n a t i o n
*/
start:
call setup$output$file;
do forever;
call setup$input$file;
call copy$file;
if nxt$chr$adr = 0 then
do;
ret = close$file (.fcbout);
call system$reset;
end;
end;
error:
call crlf;
tbuff(tbuff(0)+1) = '$';
call print$console$buffer (old$nxt$chr$adr);
call system$reset;
end concat;


Binary file not shown.

View File

@@ -0,0 +1,679 @@
$title('MP/M 1.1 System Generation')
gensys:
do;
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
/* Gensys Gensys Gensys Gensys Gensys Gensys */
$include (copyrt.lit)
/*
Revised:
7 Jan 80 by Thomas Rolander
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare start label;
declare jmp$to$start structure (
jmp$instr byte,
jmp$location address ) data (
0C3H,
.start-3);
declare copyright (*) byte data (
'COPYRIGHT (C) 1980, DIGITAL RESEARCH ');
declare serial$number (6) byte data (
'654321');
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;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
system$reset:
procedure;
call mon1 (0,0);
end system$reset;
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
print$console$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$console$buffer;
read$console$buffer:
procedure (buffer$address);
declare buffer$address address;
declare buf based buffer$address (1) byte;
buf(1) = 0;
do while buf(1) = 0;
call mon1 (10,buffer$address);
if buf(1) = 0
then call print$console$buffer (.(0ah,'?','$'));
end;
buf(buf(1)+2) = 0;
end read$console$buffer;
open$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (15,fcb$address);
end open$file;
close$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (16,fcb$address);
end close$file;
search$first:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (17,fcb$address);
end search$first;
search$next:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (18,fcb$address);
end search$next;
delete$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
read$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (20,fcb$address);
end read$record;
write$record:
procedure (fcb$address);
declare fcb$address address;
if mon2 (21,fcb$address) <> 0 then
do;
call print$console$buffer (.(
'Disk write error','$'));
call system$reset;
end;
end write$record;
create$file:
procedure (fcb$address);
declare fcb$address address;
if mon2 (22,fcb$address) = 255 then
do;
call print$console$buffer (.(
'Directory full','$'));
call system$reset;
end;
end create$file;
set$DMA$address:
procedure (DMA$address);
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
gnctran:
procedure(b) byte;
declare b byte;
if b < ' ' then return 0dh; /* all non-graphics */
/* translate alpha to upper case */
if b >= 'a' and b <= 'z' then
b = b and 101$1111b; /* upper case */
return b;
end gnctran;
parse:
procedure (pcb$adr) address;
declare pcb$adr address;
declare pcb based pcb$adr structure (
filename$adr address,
fcb$adr address );
declare pcb$filename$adr address;
declare pcb$fcb$adr address;
declare filename based pcb$filename$adr (1) byte;
declare fcb based pcb$fcb$adr (1) byte;
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 */
declare fnp byte; /* index into file name buffer */
declare fnlen byte;
gnc:
procedure;
char = gnctran(filename(fnp := fnp + 1));
end gnc;
delimiter:
procedure byte;
declare i byte;
declare del(*) byte data
(0dh,' =.:<>_[],');
do i = 0 to last(del);
if char = del(i) then return true;
end;
return false;
end delimiter;
putchar:
procedure;
fcb(fnlen:=fnlen+1) = char;
/* can check here for ambig ref's "char = '?'" */
end putchar;
fillq:
procedure(len);
/* fill current name or type with question marks */
declare len byte;
char = '?'; /* question mark */
do while fnlen < len;
call putchar;
end;
end fillq;
/* initialize local bases */
pcb$filename$adr = pcb.filename$adr;
pcb$fcb$adr = pcb.fcb$adr;
/* initialize file control block to empty */
char = ' ';
fnlen = 0;
fnp = -1;
do while fnlen < fcbsize-1;
if fnlen = fcbtype then char = 0;
call putchar;
end;
disk = 0;
/* scan next name */
do forever;
/* deblank command buffer */
call gnc;
do while char = ' ';
call gnc;
end;
if delimiter then return badfile;
fnlen = 0;
do while not delimiter;
if fnlen >= fcbname then /* error, file name too long */
return badfile;
if char = '*' then call fillq(fcbname); else call putchar;
call gnc;
end;
/* check for disk name */
if char = ':' then
do;
if not (disk = 0 and fnlen = 1) then
return badfile;
/* must be a disk name */
if (disk := fcb(1) - 'A' + 1) > 26
/* invalid disk name */
then return badfile;
/* valid disk name replace space in name */
else fcb(fnlen) = ' ';
end;
else
do;
/* char is not ':', so file name is set. scan remainder */
/* at least one char scanned */
fnlen = fcbname;
if char = '.' then /* scan file type */
do;
call gnc;
do while not delimiter;
if fnlen >= fcbtype then
/* error, type field too long */
return badfile;
if char = '*'
then call fillq(fcbtype);
else call putchar;
call gnc;
end;
end;
if char = 0dh
then return endline;
else return .filename(fnp);
end;
end; /* of forever */
end parse;
declare pcb structure (
filename$adr address,
fcb$adr address );
declare nxt$chr$adr address;
declare old$nxt$chr$adr address at (.pcb.filename$adr);
declare char byte;
declare ret byte at (.char);
declare delim based nxt$chr$adr byte;
declare fcbin (33) byte;
declare fcbout (33) byte initial (
0,' ',' ',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare default$fcb (33) byte data (
0,' ',' ',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare rspfcb (33) byte initial (
0,'????????','RSP',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare nmb$sect literally '32';
declare buffer (nmb$sect) structure (
record (128) byte);
declare sysdatpg (256) byte at (.buffer(1));
setup$output$file:
procedure;
pcb.filename$adr = .tbuff(1);
pcb.fcb$adr = .fcbout;
nxt$chr$adr = parse (.pcb);
if delim <> '=' then
do;
if nxt$chr$adr = 0 then
do;
call print$console$buffer (.(
'No input files specified','$'));
go to error;
end;
if nxt$chr$adr = 0ffffh then
do;
call print$console$buffer (.(
'Bad output file name','$'));
go to error;
end;
call print$console$buffer (.(
'A ''='' delimeter expected after output file name','$'));
go to error;
end;
call set$DMA$address (.buffer);
if open$file (.fcbout) <> 255
then call delete$file (.fcbout);
call create$file (.fcbout);
end setup$output$file;
setup$input$file:
procedure;
pcb.filename$adr = nxt$chr$adr + 1;
pcb.fcb$adr = .fcbin;
call move (33,.default$fcb,.fcbin);
if (nxt$chr$adr := parse (.pcb)) = 0ffffh then
do;
call print$console$buffer (.(
'Bad input file name','$'));
go to error;
end;
call set$DMA$address (.buffer);
if open$file (.fcbin) = 255 then
do;
call print$console$buffer (.(
'No such input file','$'));
go to error;
end;
end setup$input$file;
copy$file:
procedure;
declare (i,cnt) byte;
declare ok boolean;
do forever;
cnt = 0;
ok = true;
do while ok;
call set$DMA$address (.buffer(cnt));
if (ok := (read$record (.fcbin) = 0)) then
do;
ok = ((cnt:=cnt+1) <> nmb$sect);
end;
else
do;
if cnt = 0 then return;
end;
end;
do i = 0 to cnt-1;
call set$DMA$address (.buffer(i));
call write$record (.fcbout);
end;
if cnt <> nmb$sect then return;
end;
end copy$file;
declare lnbfr (14) byte initial (12);
response:
procedure byte;
call read$console$buffer (.lnbfr);
return (lnbfr(2) = 'y') or (lnbfr(2) = 'Y');
end response;
get$param:
procedure (string$adr,val$adr);
declare (string$adr,val$adr) address;
declare val based val$adr byte;
declare char byte;
declare lbindx byte;
call print$console$buffer (string$adr);
val = 0;
call read$console$buffer (.lnbfr);
lbindx = 1;
do while (char := gnctran(lnbfr(lbindx:=lbindx+1))) <> 0dh;
if char = ',' then
do;
val$adr = val$adr + 1;
val = 0;
end;
else
do;
char = char - '0';
if char > 9 then
do;
if char > 16
then char = char - 7;
else char = 255;
end;
if char < 16 then
do;
val = val*16 + char;
end;
else
do;
char,
val = 0;
call print$console$buffer (.(
'<- bad character, re-enter',0ah,0dh,'$'));
call print$console$buffer (string$adr);
call read$console$buffer (.lnbfr);
end;
end;
end;
call crlf;
end get$param;
make$system$dat:
procedure;
declare i byte;
call move (12,.(0,'SYSTEM DAT'),.fcb);
call set$DMA$address (.buffer);
if open$file (.fcb) <> 255
then call delete$file (.fcb);
call create$file (.fcb);
do i = 0 to 255;
sysdatpg(i) = 0;
end;
call move (43,.copyright,.sysdatpg(144));
call print$console$buffer (.( 0ah,0dh,
'MP/M 1.1 System Generation',0dh,0ah,
'==========================',0dh,0ah,0ah,'$'));
call get$param (.('Top page of memory = ','$'),
.sysdatpg(0));
call get$param (.('Number of consoles = ','$'),
.sysdatpg(1));
call get$param (.('Breakpoint RST # = ','$'),
.sysdatpg(2));
call print$console$buffer (
.('Add system call user stacks (Y/N)? ','$'));
sysdatpg(3) = response;
call print$console$buffer (.(0dh,0ah,
'Z80 CPU (Y/N)? ','$'));
sysdatpg(5) = response;
call print$console$buffer (.(0dh,0ah,
'Bank switched memory (Y/N)? ','$'));
sysdatpg(4) = response;
if sysdatpg(4) then
do;
call print$console$buffer (.(0dh,0ah,
'Banked BDOS file manager (Y/N)? ','$'));
sysdatpg(6) = response;
/* Bank switched memory segment table input */
call print$console$buffer (.(0ah,0dh,
'Enter memory segment table: (ff terminates list)',
0ah,0dh,'$'));
sysdatpg(15) = 0;
i = 16;
do while sysdatpg(i) <> 0ffh;
if i = 48 then
do;
call print$console$buffer (.(
' Entry terminated, 8 segments maximum',0dh,0ah,'$'));
sysdatpg(48) = 0ffh;
end;
else
do;
call get$param (.(' Base,size,attrib,bank = ','$'),
.sysdatpg(i));
if sysdatpg(i) <> 0ffh then
do;
sysdatpg(15) = sysdatpg(15) + 1;
i = i + 4;
end;
end;
end;
end;
else
do;
call print$console$buffer (.(0ah,0dh,
'Memory segment bases, (ff terminates list)',0ah,0dh,'$'));
sysdatpg(i:=112) = 0;
do while sysdatpg(i) <> 0ffh;
i = i + 1;
if i = 121 then
do;
sysdatpg(121) = 0ffh;
call print$console$buffer (.(
' : ff <- forced end, 8 segments maximum',0dh,0ah));
end;
else
do;
call get$param (.(' : ','$'),.sysdatpg(i));
if i = 113 then
do;
if sysdatpg(113) = 0ffh then
do;
sysdatpg(113) = 0;
sysdatpg(114) = 0ffh;
i = 114;
end;
end;
else
do;
if sysdatpg(i) <= sysdatpg(i-1) then
do;
i = i - 1;
call print$console$buffer (.(
'*** error ***',
' segment base must be greater than previous',
0dh,0ah,'$'));
end;
end;
end;
end;
sysdatpg(15) = i - 113;
end;
call set$DMA$address (.sysdatpg);
call write$record (.fcb);
call set$DMA$address (.sysdatpg(128));
call write$record (.fcb);
call close$file (.fcb);
end make$system$dat;
declare rsp$filename (12) byte initial (
'-------- ? ','$');
setup$cmd$tail:
procedure;
declare (i,ret,ptr) byte;
declare actual$rspfcb$adr address;
declare actual$rspfcb based actual$rspfcb$adr (1) byte;
declare nchars literally '45';
call move (nchars,.('mpm.sys=system.dat,xios.spr,',
'bdos.spr,xdos.spr'),.tbuff(1));
if sysdatpg(6)
then tbuff(29) = 'o';
call set$DMA$address (.buffer);
ret = search$first (.rspfcb);
ptr = nchars;
if ret <> 255 then
do;
call print$console$buffer (.(
'Select Resident System Processes: (Y/N)',0dh,0ah,'$'));
do while ret <> 255;
actual$rspfcb$adr = .buffer + (ret mod 4)*32;
call move (8,.actual$rspfcb(1),.rsp$filename);
call print$console$buffer (.rsp$filename);
if response then
do;
tbuff(ptr:=ptr+1) = ',';
do i = 1 to 11;
if i = 9
then tbuff(ptr:=ptr+1) = '.';
if actual$rspfcb(i) <> ' '
then tbuff(ptr:=ptr+1) = actual$rspfcb(i);
end;
end;
call crlf;
ret = search$next (.rspfcb);
end;
end;
tbuff(ptr:=ptr+1) = 0;
tbuff(0) = ptr;
end setup$cmd$tail;
/*
F i l e C o n c a t e n a t i o n
*/
declare last$dseg$byte byte
initial (0);
start:
if fcb(1) = ' ' then
do;
call make$system$dat;
call setup$cmd$tail;
end;
call setup$output$file;
do forever;
call setup$input$file;
call copy$file;
if nxt$chr$adr = 0 then
do;
call close$file (.fcbout);
call system$reset;
end;
end;
error:
call crlf;
tbuff(tbuff(0)+1) = '$';
call print$console$buffer (old$nxt$chr$adr);
call system$reset;
end gensys;


View File

@@ -0,0 +1,15 @@
era b:*.lst
era b:*.lin
era b:*.sym
era b:*.bak
isdd
plm80 :f1:gensys.plm pagewidth(80) debug
link :f1:gensys.obj,:f1:x0100,plm80.lib to :f1:gensys.mod
locate :f1:gensys.mod code(0100H) stacksize(100)
era b:gensys.mod
cpm
objcpm b:gensys
pip lst:=b:gensys.lst
pip lst:=b:gensys.sym[pt8]
pip lst:=b:gensys.lin[pt8]


View File

@@ -0,0 +1,15 @@
era b:*.lst
era b:*.lin
era b:*.sym
era b:*.bak
isdd
plm80 :f1:gensys.plm pagewidth(80) debug
link :f1:gensys.obj,:f1:x0100,plm80.lib to :f1:gensys.mod
locate :f1:gensys.mod code(0100H) stacksize(100)
era b:gensys.mod
cpm
objcpm b:gensys
;pip lst:=b:gensys.lst
;pip lst:=b:gensys.sym[pt8]
;pip lst:=b:gensys.lin[pt8]


View File

@@ -0,0 +1,170 @@
:10010000C32103434F50595249474854202843299B
:1001100020313938302C204449474954414C205231
:1001200045534541524348203635343332314469D2
:10013000736B2072656164206572726F7224930A1A
:1001400053796E6368726F6E697A6174696F6E2439
:10015000426164206669727374207265636F7264B1
:10016000206F66205350522F5253502068656164AF
:10017000657224426164207365636F6E64207265EA
:10018000636F7264206F66205350522F5253502079
:1001900068656164657224556E6578706563746521
:1001A0006420656E64206F662066696C652C206F24
:1001B00072206469736B2072656164206572726F6E
:1001C00072245253504D504D2E53595320646F6535
:1001D00073206E6F74206578697374244E756D6238
:1001E0006572206F6620636F6E736F6C6573203D60
:1001F0002020240D0A427265616B706F696E742055
:1002000052535420232020203D2020240D0A5A3808
:100210003020435055240D0A42616E6B65642042C4
:10022000444F532066696C65206D616E616765722D
:10023000240D0A546F70206F66206D656D6F7279A2
:100240002020202020203D240D0A0A4D656D6F726C
:1002500079205365676D656E74205461626C653AF0
:100260000D0A2453595354454D2020444154434FC3
:100270004E534F4C452044415455534552535953C6
:100280002053544B2D2D2D2D2D2D2D2D2D2D2D2D40
:100290002D2D2D2D2D2D2D2D2D2D2D2D2D0D0A24DA
:1002A0004D656D736567202055737224202042616F
:1002B0006E6B20240D0A0A4D502F4D20312E312017
:1002C0004C6F616465720D0A3D3D3D3D3D3D3D3DD8
:1002D0003D3D3D3D3D3D3D0D0A0A2458494F5320CB
:1002E0002020205350522442444F5320202020539A
:1002F00050522458444F532020202053505224421F
:100300004E4B42444F5320535052240D0A4D502F10
:100310004D204C6F61646572206572726F723A2075
:1003200024314A0BF33A5D0032C30BCD4D0401B4C6
:1003300002CD3D04CDB70721DB02224A0B444DCD4F
:100340003D04117B0B0E00CDC4052F1FD25203C3F9
:10035000FF0321E702224A0B444DCD3D04117B0BE4
:100360000E00CDC4052F1FD26D03C3FF0321F3027E
:10037000224A0B444DCD3D04117B0B0E00CDC4052C
:100380002F1FD28803C3FF030103002A6C0B09E56A
:100390002A700BEBE17323722A6C0B22C10B110044
:1003A00021011601CD4E0521000022FE21117B0BFB
:1003B0000EFFCDC4051FD2CE032A6C0BE52AFE2109
:1003C000EBE17323722A6C0B22FE21C3AD033A06C4
:1003D000211FD2E30321FF02224A0B444DCD3D04ED
:1003E000CD8C07CD4909210001E52A700BEB0100F6
:1003F00021E10A1203132B7CB5C2F203CD950A3119
:100400004A0B010B03CD3D042A4A0B444DCD3D045C
:100410003EFF1FD22004210000F9F3FB76C3100435
:10042000FB76210000224C0B214C0BF9C9214E0B0D
:10043000712A4E0B2600EB0E02CD060DC921500B82
:10044000702B712A4F0BEB0E09CD060DC911000060
:100450000E0DCD060DC921520B702B712A510BEBDD
:100460000E0FCD060DC921540B702B712A530BEBC7
:100470000E14CD060DC921560B702B712A550BEBAE
:100480000E1ACD060DC90E0DCD2D040E0ACD2D046C
:10049000C921570B713E0921570BBED2AC043A5704
:1004A0000BC641D60A4FCD2D04C3B5043A570BC62F
:1004B000304FCD2D04C921580B713A580BE6F81F67
:1004C0001F1F1F4FCD91043A580BE60F4FCD9104DB
:1004D000C9215A0B702B710E20CD2D040E20CD2D6D
:1004E000042A590B7C4FCDB6042A590B7D4FCDB64B
:1004F000040E48CD2D04C9215C0B702B71215D0BBE
:1005000036003E0A215D0BBEDA20052A5D0B26006F
:10051000EB2A5B0B194ECD2D04215D0B34C2020575
:10052000C921630B722B732B702B712BD1C1702BD4
:1005300071D52A5E0B444DCDF7042A600B444DCD96
:10054000D1042A620B444DCDD104CD8604C9216764
:100550000B722B732B702B713EFF1FD2C3052168CA
:100560000B36FF2336FF3A680B3C32680B4F060010
:100570002A640B093A690B3C32690B4F0600E52AE5
:10058000660B09C10ABEC28C05C366053E17216809
:100590000BBED29605C93E0011660BCD030BB5D636
:1005A000019FEBF53E1123969FC148B11FD2B905BB
:1005B000214001224A0BC3FF032A660B2322660B4C
:1005C000C35805C921C80B722B732B71010020CDB4
:1005D00076042AC70B444DCD660432740BFE00CA64
:1005E000F6053A740BFE01C2ED053E00C92150012B
:1005F000224A0BC3FF03018020CD76042AC70B4497
:100600004DCD6604D600C6FF9F32740B1FD219066B
:10061000217301224A0BC3FF030E03210120CDE603
:100620000A1BCDB60A117F00190E07CDEA0AEB218D
:10063000720B73210022226A0B21010022770B3AF0
:10064000720B21770BCD0E0BDA83062A6A0B444D11
:10065000CD76041180002A6A0B19226A0B2AC70B77
:10066000444DCD660432740BFE00CA760621970114
:10067000224A0BC3FF031101002A770B1922770BC3
:10068000D23F062A6C0B226E0B2A0420EB2A012093
:100690001911FF00191100FFCDC10A116E0BCD0613
:1006A0000B226C0B3AC60B1FDAC1062A6C0B444DA9
:1006B000CDD104016C0B116E0BCDF60A444DCDD19A
:1006C000042A6C0B7C32750B2A01200100220922BE
:1006D000C40B21000022790B21730B36802100000E
:1006E00022770B2A01202BEB21770BCD110BDA524D
:1006F000072A790BEB2AC40B193A730BA6FE00CA22
:1007000019072A770B010022093A750B862A770B05
:10071000EB2A6C0B1977C32C072A770B01002209EF
:10072000E52A770BEB2A6C0B19D11A773A730BB7C2
:100730001F32730BFE00C2450721730B36802A79E6
:100740000B2322790B1101002A770B1922770BD288
:10075000E3063AC60B1FD284072E0311102201C2F2
:10076000010A1203132DC26107010822C5016C0B97
:10077000116E0BCDF60AEB2A6C0B444DCD21050111
:10078000FFFF79C9CD860401FFFF79C9010020CDA3
:100790007604019C0BCD5604FEFFC2A007C3FF03E5
:1007A000119C0B0E00CDC4052F1FD2B007C3FF0351
:1007B0002A6C0B220721C9010021CD7604017B0B95
:1007C000CD5604FEFFC2D10721C501224A0BC3FF4B
:1007D00003017B0BCD660432740BFE00CAE207C333
:1007E000FF03018021CD7604017B0BCD66043274BA
:1007F0000BFE00CAF907C3FF033A0021FE00C24303
:10080000082100FF226C0B01FFFF21760B713A7665
:100810000B1FD23C082A6C0B365A2A6C0B7EFE5AF0
:10082000C22B0821760B3600C33908010001116C78
:100830000BCDFB0AEB2B732372C30E082A6C0B7CC7
:100840003200212A002126000E08CDE00A22700B7A
:10085000226C0B01DC01CD3D042A01214DCD910418
:1008600001F301CD3D042A02214DCD91043A052129
:100870001FD27A08010C02CD3D043A06211FD2870F
:1008800008011602CD3D04013102CD3D0411FF00E7
:100890002A6C0B19444DCDD104014802CD3D040111
:1008A0006302C52A6C0B444D110001CD21051100D6
:1008B000012A01212600CDC80A226E0B116C0BCD36
:1008C000060BEB2B732372016E02C52A6C0B444D91
:1008D0002A6E0BEBCD21053A03211FD2480921C90D
:1008E0000B36003A0F213D21C90BBEDA1809114021
:1008F000002AC90B2600CDC80A116C0BCD060BE5EA
:100900002AC90B26000150212909C17123703AC957
:100910000B3C32C90BC2E3083A0F213DE6FE1F1F14
:100920003C6F2600110001CDC80A226E0B116C0B22
:10093000CD060BEB2B732372017902C52A6C0B4495
:100940004D2A6E0BEBCD2105C93A04211FD259095E
:100950003A0F2132720BC3AE0921720B360101FF2F
:10096000FF21760B713A760B1FD2AE092A720B2645
:100970000001702109E52A6C0B7C4FD11AB9DAA469
:10098000092A6C0B7C2A720B260001702109773A28
:10099000720B3D32720B3A720B320F2121760B36FD
:1009A00000C3AB093A720B3C32720BC36509018478
:1009B00002CD3D043A720BFE00CA920A3A720B3D18
:1009C00032720B01A002CD3D043A04212F1FD22F19
:1009D0000A2A720B260001712109E52A720B2600F2
:1009E000292901102109D11A772A720B26000172D8
:1009F0002109E52A720B26000B09D11A962A720BDF
:100A0000260029290110210901010009772A720B0A
:100A100026002929011021090102000936002A7245
:100A20000B26002929011021090103000936002A9B
:100A3000720B26002929011021094E060060690E5B
:100A400008CDE00A444DCDD1042A720B2600292995
:100A500001102109010100094E060060690E08CD50
:100A6000E00A444DCDD1043A04211FD28C0A01ACD6
:100A700002CD3D042A720B2600292901102109010B
:100A80000300094ECDB6040E48CD2D04CD8604C317
:100A9000B409C9F3C921C10BF93AC30BFE42C2B074
:100AA0000A3A0221878787F6C72A3E0177CD930A43
:100AB000C9EB5F1600EB1A856F131A8C67C95F16B6
:100AC000007BA56F7AA467C9444D2100003E102920
:100AD000EB29EBD2D70A093DC2CF0AC95E2356EBF8
:100AE000290DC2E00AC95E2356EB7CB71F677D1F44
:100AF0006F0DC2EA0AC969604E23461A916F131A34
:100B00009867C96F26001A956F131A9C67C95F16FC
:0A0B1000007B965F7A239E57EBC925
:020B4A002E017A
:100B7B00004D504D202020202053595300000000E1
:100B8B00000000000000000000000000000000005A
:100B9B000000424E4B42444F532053505200000032
:100BAB00000000000000000000000000000000003A
:020BBB00000038
:00032101DB


View File

@@ -0,0 +1,11 @@
$title ('MP/M 1.0 Loader BDOS Interface')
name ldmonx
cseg
public ldmon1,ldmon2
ldmon1 equ 0d06h
ldmon2 equ 0d06h
end


File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,149 @@
:100D0000000000000000C3110D9A0DA60DAC0DB23D
:100D10000DEB22C00EEB7B32701621000022C20EBA
:100D200039228C0E31BE0EAF327A16327816211F60
:100D300016E579FE25D04B21440D5F160019195E8A
:100D40002356EBE900178E0D8F0D8E0D8E0D8E0D37
:100D50008E0D8E0D8E0D920D8E0D8E0D8E0DEA1553
:100D60008E0D06168E0D8E0D8E0D8E0D0F168E0DA0
:100D70008E0D8E0D8E0D8E0D16168E0D8E0D8E0D0A
:100D80008E0D8E0D8E0D8E0D8E0D8E0D8E0DC9C39A
:100D90005B0E2AC00E4D44C3790E21E40DCDBB0D70
:100DA000FE03CA0000C921EF0DC3B50D21FB0DC321
:100DB000B50D21F60DCDBB0DC30000E5CD6F0E3A8C
:100DC000BF0EC64132E00D01D40DCD790EC1CD79F3
:100DD0000EC3091742646F7320457272204F6E2054
:100DE000203A202442616420536563746F72245357
:100DF000656C6563742446696C6520522F4F243AF4
:100E00008B0EB7C2210ECD0617E601C8CD0917FE1D
:100E100013C21E0ECD0917FE03CA0000AFC9328BE4
:100E20000E3E01C93A870EB7C23E0EC5CDFF0DC1B9
:100E3000C5CD0C17C1C53A8A0EB7C40F17C17921A9
:100E4000890EFE7FC834FE20D0357EB7C879FE08F3
:100E5000C2550E35C9FE0AC03600C979FE09C22442
:100E60000E0E20CD240E3A890EE607C2610EC90E81
:100E70000DCD240E0E0AC3240E0AFE24C803C54F4E
:0C0E8000CD5B0EC1C3790E000000000025
:020EBE00000032
:100EC4005E2356EBE921090DC3C40E210B0DC3C4E7
:100ED4000E210D0DC3C40E210F0DC3C40E0C0DC87D
:100EE4001A771323C3E20E3ABF0E4FCD1B177CB5FE
:100EF400C85E235623224D162323224F1623232272
:100F040051162323EB226A162153160E08CDE10E47
:100F14002A5516EB215B160E0FCDE10E2A60167CC6
:100F240021771636FFB7CA2F0F36003EFFB7C9CD5B
:100F340018172168164E2346CD1E17AF2A4F167771
:100F440023772A5116772377C9CD2717B7C2C90E3D
:100F5400C9C9217F164E23462A51165E23562A4FAD
:100F6400167E23666F7993789AD27F0FE52A5B16F3
:100F74007B955F7A9C57E12BC3690FE52A5B1619B1
:100F84007995789CDA910FEBE123C37F0FE1C5D506
:100F9400E5EB2A681619444DCD1E17D12A4F167356
:100FA4002372D12A5116732372C179934F789A47C9
:100FB4002A6A16EBCD30174D44C32117215D164E16
:100FC4003A7D16B71F0DC2C70F473E08964F3A7CAD
:100FD400160DCADE0FB717C3D50F80C92AC00E116C
:100FE400100019093A7716B7CAF30F6E2600C9091B
:100FF4005E2356EBC9CDC00F4F0600CDE00F227F14
:1010040016C92A7F167DB4C93A5D162A7F16293D72
:10101400C212103A5E164F3A7D16A1B56F227F16A2
:10102400C92AC00E110C0019C92AC00E110F0019CB
:10103400EB21110019C9CD2D107E327D16EB7E32C5
:101044007B16CD25103A5F16A6327C16C9CD2D101D
:101054003A6F164F3A7D168177EB3A7B1677C90CB7
:101064000DC87CB71F677D1F6FC364102A82160EDC
:1010740002CD6310227F16228416C3560F0E802AD7
:101084005316AF86230DC28710C90C0DC829C38F10
:1010940010C53ABF0E4F210100CD8E10C179B56F36
:1010A40078B467C92A47163ABF0E4FCD63107DE660
:1010B40001C92147164E2346CD95102247162A62B0
:1010C40016EB2A4D16732372C9110900197E17D025
:1010D400C3DB0ECDE910C3CD10CDA810C8C3D50E07
:1010E400856FD024C92A53163A8116C3E4102AC046
:1010F4000E110E00197EC9CDF2103600C9CDF210C2
:10110400F68077C93E0132C20EC92A8216EB2A4DF7
:10111400167B96237A9EC9CD0E11D813722B73C9F0
:101124007B956F7A9C67C90EFF2A8416EB2A661694
:10113400CD2411D0C5CD81102A5716EB2A84161957
:10114400C10CCA5311BEC8CD0E11D0CDB610C9778B
:10115400C94E2346C32417214B16C35511215316D8
:10116400C35511CD2B11CD61110E01CD550FC35BAC
:1011740011CD6111CD4D0FC35B112A5316EB2A4BD0
:10118400160E80C3E10E2182167E23BEC03CC92107
:10119400FFFF228216C92A6216EB2A8216232282B4
:1011A40016CD2411D2AF11CD9311C93A8216E6039C
:1011B40006058705C2B611328116B7C0C5CD7010B9
:1011C400CD7511C1C32D110F15C2CB1177C979E6A5
:1011D400073C5F57790F0F0FE61F4F788787878784
:1011E40087B14F780F0F0FE61F472A5916097E075C
:1011F4001DC2F311C9D5CDD211E6FEC1B1C3CB11C5
:10120400CDE91011100019C50E11D10DC8D53A77CA
:1012140016B7CA2112C5E54E0600C327120DC54EE6
:101224002346E579B0C4F911E123C1C30E122A6043
:10123400160E03CD631023444D2A59163600230B92
:1012440078B1C240122A6416EB2A5916732372CD60
:10125400330F2A4D163603233600CD93110EFFCDDE
:101264009A11CD8A11C8CDE9103EE5BECA61123A81
:10127400BE0EBEC28512237ED624C285123D32C262
:101284000E0E01CD0412CD1B11C361123A6E16323B
:10129400C20EC9C5F53A5F162F4779A04FF1A09148
:1012A400E61FC1C90E00CD9A11CD8A11CA0F132AA7
:1012B4007316EB1AFEE5CAC512D5CD0E11D1D20FA5
:1012C40013CDE9103A72164F060079B7CAFE121A06
:1012D400FE3FCAF71278FE0DCAF712FE0C1ACAEEC8
:1012E4001296E67FC2A812C3F712C54ECD9712C15B
:1012F400C2A8121323040DC3CE123A8216E6033297
:10130400C20E216E167E17D0AF77C9CD93113EFF62
:1013140032C20EC93EFF326E16217216712AC00EF9
:10132400227316CD9311CD330FC3A812CDDD100E49
:101334000CCD1813CD8A11C8CDD710CDE91036E5E0
:101344000E00CD0412CD6711CDA812C33813505925
:1013540079B0CA65130BD5C5CDD2111FD28013C184
:10136400D12A60167B957A9CD2881313C5D5424B3B
:10137400CDD2111FD28013D1C1C35413173CCDCB8E
:1013840011E1D1C9210000C9D506002AC00E09EB1C
:10139400CDE910C1CDE10ECD7010C367110E001E52
:1013A40020C38C13CDDD100E0CCD18132AC00E7E75
:1013B4001110001977CD8A11C8CDD7100E101E0C4C
:1013C400CD8C13CDA812C3B9130E0CCD1813CD8A2E
:1013D40011C80E001E0CCD8C13CDA812C3D2130E4F
:1013E4000FCD1813CD8A11C8CD25107EF5E5CDE9B2
:1013F40010EB2AC00E0E20D5CDE10ECD0111D12166
:101404000C00194E210F001946E1F17779BE78CA14
:101414001D143E00DA1D143E802AC00E110F00195F
:1014240077C97E23B62BC01A7713231A771B2BC9CF
:10143400AF32C20ECDA810C0CDF210E680C00E0FA0
:10144400CD1813CD8A11C8011000CDE91009EB2A7B
:10145400C00E090E103A7716B7CA74147EB71AC2B2
:10146400671477B7C26D147E12BEC2AC14C389145C
:10147400CD2614EBCD2614EB1ABEC2AC1413231ADA
:10148400BEC2AC140D13230DC2591401ECFF09EBB9
:10149400091ABEDAA3147701030009EB097E123E90
:1014A400FF326C16CD9B13C921C20E35C9CDDD1098
:1014B4002AC00EE521461622C00E0E01CD1813CD0A
:1014C4008A11E122C00EC8EB210F00190E11AF776B
:1014D400230DC2D314210D001977CD1B11CDA113F7
:1014E400C30111AF326C16CD3414CD8A11C82AC091
:1014F4000E010C00097E3CE61F77CA1015473A5FBF
:1015040016A0216C16A6CA1B15C3391501020009C1
:10151400347EE60FCA44150E0FCD1813CD8A11C2BE
:1015240039153A6D163CCA4415CDB114CD8A11CA89
:101534004415C33C15CDEC13CD3A10AF32C20EC9DD
:10154400CD0811C301113E01326F163EFF326D16F4
:10155400CD3A103A7D16217B16BEDA7415FE80C290
:101564008A15CDE714AF327D163AC20EB7C28A157A
:10157400CDF90FCD0610CA8A15CD0C10CD560FCD5E
:101584004D0FCD5110C9C308112A49163ABF0E4F49
:10159400CD6310E5EBCDEB0EE1CCCF0E7D1FD82A49
:1015A40049164D44CD9510224916C332123A70168D
:1015B40021BF0EBEC877C38D153EFF3278162AC0F0
:1015C4000E7EE61F3D327016FE1ED2E1153ABF0EA6
:1015D4003279167E327A16E6E077CDB1153ABE0E30
:1015E4002AC00EB677C9210000224716224916AF39
:1015F40032BF0E218000224B16CD5B11C38D15C363
:10160400B115CDFB10CDBD15C3E313CDBD15CD4A2A
:1016140015C92AC00E224B16C35B113A7816B7CAF5
:101624003C162AC00E36003A7A16B7CA3C16773AE8
:101634007916327016CDB1152A8C0EF92AC20E7D98
:0916440044C9E50000000080002B
:0000000000


View File

@@ -0,0 +1,96 @@
title 'Skeleton MP/M 1.1 Ldrbios'
; Copyright (C) 1978, 1979, 1980
; Digital Research
; Box 579, Pacific Grove
; California, 93950
false equ 0
true equ not false
ram$top equ 1d00h ; top address+1
bios equ ram$top-0600h ; basic input/output system
bdos equ bios-0e00h ; base of the bdos
org bios
buff equ 0080h ;default buffer address
; jump vector for indiviual routines
jmp boot
wboote: jmp wboot
jmp const
jmp conin
jmp conout
jmp list
jmp punch
jmp reader
jmp home
jmp seldsk
jmp settrk
jmp setsec
jmp setdma
jmp read
jmp write
jmp list$st ; list status poll
jmp sect$tran ; sector translation
boot:
wboot:
gocpm:
ret
crtin: ; crt: input
ret
crtout: ; crt: output
ret
crtst: ; crt: status
ret
ttyin: ; tty: input
ret
ttyout: ; tty: output
ret
lptout: ; lpt: output
ret
lpt$st:
ret
conin equ crtin
const equ crtst
conout equ crtout
reader equ ttyin
punch equ ttyout
list equ lptout
listst equ lptst
seldsk: ;select disk given by register c
ret
;
home: ;move to home position
ret
;
settrk: ;set track number given by c
ret
;
setsec: ;set sector number given by c
ret
;
setdma: ;set dma address given by regs b,c
ret
;
sect$tran: ; translate the sector # in <c> if needed
ret
;
read: ;read next disk record (assuming disk/trk/sec/dma set)
ret
;
write: ;disk write function
ret
;
end


View File

@@ -0,0 +1,7 @@
:10170000C33317C33317C33617C33417C33517C3CF
:101710003917C33817C33717C33C17C33B17C33D2B
:1017200017C33E17C33F17C34117C34217C33A1726
:10173000C34017C9C9C9C9C9C9C9C9C9C9C9C9C95A
:03174000C9C9C94B
:0000000000


View File

@@ -0,0 +1,7 @@
pip lst:=b:mpmldr.lst
pip lst:=b:mpmldr.sym[pt8]
pip lst:=b:mpmldr.lin[pt8]
pip lst:=b:gensys.lst
pip lst:=b:gensys.sym[pt8]
pip lst:=b:gensys.lin[pt8]


Binary file not shown.

View File

@@ -0,0 +1,553 @@
$title ('MP/M 1.1 Loader')
mpmldr:
do;
/*
Copyright (C) 1979,1980
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
Revised:
18 Jan 80 by Thomas Rolander
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare start label;
declare jmp$to$start structure (
jmp$instr byte,
jmp$location address ) data (
0C3H,.start-3);
declare copyright (*) byte data (
'COPYRIGHT (C) 1980,');
declare company$name (*) byte data (
' DIGITAL RESEARCH ');
declare serial$number (6) byte data (
'654321');
declare err$msgadr address initial (.default$err$msg);
declare default$err$msg (*) byte data (
'Disk read error','$');
declare mon1 literally 'ldmon1';
declare mon2 literally 'ldmon2';
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;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
system$reset:
procedure;
declare dummy address;
dummy = 0;
stackptr = .dummy;
end system$reset;
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
print$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$buffer;
reset$disk$system:
procedure;
call mon1 (13,0);
end reset$disk$system;
open$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (15,fcb$address);
end open$file;
read$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (20,fcb$address);
end read$record;
set$DMA$address:
procedure (DMA$address);
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
/**************************************
* *
* Misc. BDOS procs *
* *
**************************************/
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
printnib:
procedure (n);
declare n byte;
if n > 9
then call write$console (n+'A'-10);
else call write$console (n+'0');
end printnib;
printhex:
procedure (b);
declare b byte;
call printnib (shr(b,4));
call printnib (b and 0fh);
end printhex;
printaddr:
procedure (a);
declare a address;
call write$console (' ');
call write$console (' ');
call printhex (high(a));
call printhex (low(a));
call write$console ('H');
end printaddr;
printname:
procedure (nadr);
declare nadr address;
declare n based nadr (1) byte;
declare i byte;
do i = 0 to 10;
call write$console (n(i));
end;
end printname;
printitems:
procedure (nadr,base,size);
declare (nadr,base,size) address;
call print$name (nadr);
call printaddr (base);
call printaddr (size);
call crlf;
end printitems;
match$serial:
procedure (cpyrtadr,memadr);
declare (cpyrtadr,memadr) address;
declare (i,j) byte;
declare cpyrt based cpyrtadr (1) byte;
declare mem based memadr (1) byte;
do forever;
i,j = -1;
do while cpyrt(i:=i+1) = mem(j:=j+1);
;
end;
if i > 23 then return;
if (memadr = 0) or (i > 17) then
do;
err$msgadr = .('Synchronization','$');
go to error;
end;
memadr = memadr + 1;
end;
end match$serial;
declare (base,cur$top,prev$top) address;
declare sysdatadr address;
declare MPMbase based cur$top structure (
jmpinstr (3) byte,
sysdat address );
declare (nrec,mask,ret,offset) byte;
declare notdone boolean;
declare (i,j) address;
declare fcb (33) byte initial (
0,'MPM ','SYS',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare banked$bdos$fcb (33) byte initial (
0,'BNKBDOS ','SPR',0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0);
declare entry$point (3) address;
declare header (256) byte at (2000h);
declare code$size address at (.header(1));
declare data$size address at (.header(4));
declare system$data (256) byte at (2100h);
/*
System Data: byte assignments
-----------------------------
000-000 Mem$top, top page of memory
001-001 Nmb$cns, number of consoles
002-002 Brkpt$RST, breakpoint RST #
003-003 Add system call user stacks, boolean
004-004 bank switched memory, boolean
005-005 Z80 version, boolean
006-006 banked bdos, boolean
007-008 base address of banked bdos
009-014 Unassigned
015-015 Max$mem$seg, max memory segment number
016-047 Memory segment table, filled in by GENSYS if
memory bank switched, otherwise by MPMLDR
048-079 Breakpoint vector table, filled in by DDTs
080-111 System call user stacks
112-121 Scratch area used for memory segmentation
122-127 Unassigned
128-143 Subflg, submit flag array
144-251 Unassigned
252-253 Sysdatadr, MP/M data page address
254-255 Rspl, resident system process link, the address
of the next Rsp, list terminates with a zero.
*/
declare mem$top byte at (.system$data(000));
declare nmb$cns byte at (.system$data(001));
declare brkpt$RST byte at (.system$data(002));
declare sys$call$stks boolean at (.system$data(003));
declare bank$switched boolean at (.system$data(004));
declare z80$cpu boolean at (.system$data(005));
declare banked$bdos boolean at (.system$data(006));
declare base$banked$bdos address at (.system$data(007));
declare nmb$mem$seg byte at (.system$data(015));
declare mem$seg$tbl (8) structure (
base byte,
size byte,
attrib byte,
bank byte )
at (.system$data(016));
declare user$stacks (16) address at (.system$data(080));
declare tmp$mem$segs (9) byte at (.system$data(112));
declare rspl address at (.system$data(254));
declare option$temp byte at (005dh);
declare option byte;
declare buffer (1) byte at (2200h);
declare sector$size literally '128';
declare destination based cur$top (1) byte;
declare link based cur$top address;
declare test$byte based cur$top byte;
declare bitmap$adr address;
declare bitmap based bitmap$adr (1) byte;
load$PRL:
procedure (get$name,fcb$adr) byte;
declare get$name boolean;
declare fcb$adr address;
call set$DMA$address (.header);
if (ret := read$record (fcb$adr)) <> 0 then
do;
if ret = 1 then return false;
err$msgadr = .('Bad first record of SPR/RSP header','$');
go to error;
end;
call set$DMA$address (.header(128));
if (ret := read$record (fcb$adr) <> 0) then
do;
err$msgadr = .('Bad second record of SPR/RSP header','$');
go to error;
end;
nrec = shr(code$size+
shr(code$size,3)+
7FH,
7);
base = .buffer;
/* read PRL+bitmap file into memory */
do i = 1 to nrec;
call set$DMA$address (base);
base = base + sector$size;
if (ret := read$record (fcb$adr)) <> 0 then
do;
err$msgadr = .('Unexpected end of file, or disk read error','$');
go to error;
end;
end;
/* offset by destination */
prev$top = cur$top;
cur$top = prev$top-((code$size+data$size+0FFH) and 0FF00H);
if not get$name then
do;
call printaddr (cur$top);
call printaddr (prev$top - cur$top);
end;
offset = high(cur$top);
/* bitmap directly follows last byte of code */
bitmap$adr = .buffer + code$size;
j = 0;
mask = 80H;
/* loop through entire bit map */
do i = 0 to code$size-1;
if (bitmap(j) and mask) <> 0 then
/* copy & offset the byte where a bitmap bit is on */
do;
destination(i) = buffer(i) + offset;
end;
else
/* simply copy it to destination */
do;
destination(i) = buffer(i);
end;
/* move mask bit one position to the right */
if (mask := shr(mask,1)) = 0 then
/* re-initialize mask and get next bitmap byte */
do;
mask = 80H;
j = j + 1;
end;
end;
if get$name then
do;
call move (3,.('RSP'),.buffer(16));
call printitems (.buffer(8),
cur$top,prev$top - cur$top);
return true;
end;
call crlf;
return true;
end load$PRL;
load$banked$bdos:
procedure;
call set$DMA$address (.header);
if open$file (.banked$bdos$fcb) = 0ffh then
do;
go to error;
end;
if not load$PRL (false,.banked$bdos$fcb) then
do;
go to error;
end;
base$banked$bdos = cur$top;
end load$banked$bdos;
load$system$data:
procedure;
declare cntr byte;
call set$DMA$address (.system$data);
if open$file (.fcb) = 0ffh then
do;
err$msgadr = .('MPM.SYS does not exist','$');
go to error;
end;
if (ret := read$record (.fcb)) <> 0 then
do;
go to error;
end;
call set$DMA$address (.system$data(128));
if (ret := read$record (.fcb)) <> 0 then
do;
go to error;
end;
if mem$top = 0 then
/* determine size of memory */
do;
cur$top = 0ff00h;
not$done = true;
do while not$done;
test$byte = 5ah;
if test$byte = 5ah
then not$done = false;
else cur$top = cur$top - 0100h;
end;
mem$top = high(cur$top);
end;
sysdatadr,
cur$top = shl(double(mem$top),8);
call print$buffer (.(
'Number of consoles = ','$'));
call printnib (nmb$cns);
call print$buffer (.(0dh,0ah,
'Breakpoint RST # = ','$'));
call printnib (brkpt$RST);
if z80$cpu then
call print$buffer (.(0dh,0ah,
'Z80 CPU','$'));
if banked$bdos then
call print$buffer (.(0dh,0ah,
'Banked BDOS file manager','$'));
call print$buffer (.(0dh,0ah,
'Top of memory =','$'));
call printaddr (cur$top + 255);
call print$buffer (.(0dh,0ah,0ah,
'Memory Segment Table:',0dh,0ah,'$'));
call printitems (.('SYSTEM DAT'),cur$top,256);
cur$top = cur$top - (prev$top := nmb$cns*256);
call printitems (.('CONSOLE DAT'),cur$top,prev$top);
if sys$call$stks then
do;
do cntr = 0 to nmb$mem$seg-1;
user$stacks(cntr) = cur$top - cntr*64;
end;
cur$top = cur$top
- (prev$top := (shr(nmb$mem$seg-1,2)+1)*256);
call printitems (.('USERSYS STK'),cur$top,prev$top);
end;
end load$system$data;
display$mem$map:
procedure;
if bank$switched then
do;
nrec = nmb$mem$seg;
end;
else
do;
nrec = 1;
notdone = true;
do while notdone;
if tmp$mem$segs(nrec) >= high(cur$top) then
do;
tmp$mem$segs(nrec) = high(cur$top);
nrec = nrec - 1;
nmb$mem$seg = nrec;
notdone = false;
end;
else
do;
nrec = nrec + 1;
end;
end;
end;
call print$buffer (.(
'-------------------------',0dh,0ah,'$'));
do while nrec <> 0;
nrec = nrec - 1;
call print$buffer (.('Memseg Usr','$'));
if not bank$switched then
do;
mem$seg$tbl(nrec).base = tmp$mem$segs(nrec+1);
mem$seg$tbl(nrec).size = tmp$mem$segs(nrec+2) -
tmp$mem$segs(nrec+1);
mem$seg$tbl(nrec).attrib = 0;
mem$seg$tbl(nrec).bank = 0;
end;
call printaddr (shl(double(mem$seg$tbl(nrec).base),8));
call printaddr (shl(double(mem$seg$tbl(nrec).size),8));
if bank$switched then
do;
call print$buffer (.(' Bank ','$'));
call printhex (mem$seg$tbl(nrec).bank);
call write$console ('H');
end;
call crlf;
end;
end display$mem$map;
Restart$instr:
procedure;
disable; /* this disable is overlayed with RST x */
end Restart$instr;
xeq$mpm:
procedure;
declare brkpt$adr address data (.Restart$instr);
declare brkpt based brkpt$adr byte;
stack$ptr = .entry$point(2);
/* if command tail starts with 'B' then break */
if option = 'B' then
do;
brkpt = 1100$0111b or shl(brkpt$RST,3);
call Restart$instr;
end;
end xeq$mpm;
/*
Main Program
*/
start:
disable; /* allows mpmldr to run under MP/M */
option = option$temp;
call reset$disk$system;
call print$buffer (.(0dh,0ah,0ah,
'MP/M 1.1 Loader',0dh,0ah,
'===============',0dh,0ah,0ah,'$'));
call load$system$data;
call print$buffer (err$msgadr:=.('XIOS SPR','$'));
if not load$PRL (false,.fcb) then
do;
go to error;
end;
call print$buffer (err$msgadr:=.('BDOS SPR','$'));
if not load$PRL (false,.fcb) then
do;
go to error;
end;
call print$buffer (err$msgadr:=.('XDOS SPR','$'));
if not load$PRL (false,.fcb) then
do;
go to error;
end;
MPMbase.sysdat = sysdatadr;
entry$point(2) = cur$top;
call match$serial (.company$name,.system$data);
/*
Load Optional RSP Files
*/
rspl = 0;
do while load$PRL (true,.fcb);
link = rspl;
rspl = cur$top;
end;
if banked$bdos then
do;
call print$buffer (err$msgadr:=.('BNKBDOS SPR','$'));
call load$banked$bdos;
end;
call display$mem$map;
call move (256,.system$data,sysdatadr);
call xeq$mpm;
error:
call print$buffer (.(0dh,0ah,
'MP/M Loader error: ','$'));
call print$buffer (err$msgadr);
do forever;
stackptr = 0;
disable;
halt;
end;
end mpmldr;


View File

@@ -0,0 +1,20 @@
isdd
plm80 :f1:mpmldr.plm pagewidth(80) debug
asm80 :f1:ldmonx.asm pagewidth(80) debug
link :f1:mpmldr.obj,:f1:ldmonx.obj,plm80.lib to :f1:mpmldr.mod
locate :f1:mpmldr.mod stacksize(48) code(0100h)
objhex :f1:mpmldr to :f1:mpmldr.hex
cpm
pip lst:=b:mpmldr.lst
pip lst:=b:ldmonx.lst
objcpm b:mpmldr
pip lst:=b:mpmldr.sym[pt8]
pip lst:=b:mpmldr.lin[pt8]
era b:*.lst
era b:*.sym
era b:*.lin
mac b:ldrbdos $$pp+s
mac b:ldrbios $$pp+s
pip b:mpmldr.hex=b:mpmldr.hex[I],b:ldrbdos.hex[I],b:ldrbios.hex[H]
load b:mpmldr


View File

@@ -0,0 +1,17 @@
isdd
plm80 :f1:mpmldr.plm pagewidth(80) debug
;asm80 :f1:ldmonx.asm pagewidth(80) debug nolist
link :f1:mpmldr.obj,:f1:ldmonx.obj,plm80.lib to :f1:mpmldr.mod
locate :f1:mpmldr.mod stacksize(48) code(0100h)
objhex :f1:mpmldr to :f1:impmldr.hex
cpm
objcpm b:mpmldr
;pip lst:=b:mpmldr.lst
;era b:*.lst
;pip lst:=b:mpmldr.sym[pt8]
;pip lst:=b:mpmldr.lin[pt8]
;mac b:ldrbdos $$pzsz
;mac b:ldrbios $$pzsz
pip b:mpmldr.hex=b:impmldr.hex[I],b:ldrbdos.hex[I],b:ldrbios.hex[H]
load b:mpmldr


View File

@@ -0,0 +1,25 @@
era b:*.lst
era b:*.lin
era b:*.sym
era b:*.bak
isdd
plm80 :f1:$1.plm pagewidth(80) debug
link :f1:$1.obj,:f1:x0100,plm80.lib to :f1:$11.mod
link :f1:$1.obj,:f1:x0200,plm80.lib to :f1:$12.mod
locate :f1:$11.mod code(0100H) stacksize(100)
locate :f1:$12.mod code(0200H) stacksize(100)
objhex :f1:$11 to :f1:$11.hex
objhex :f1:$12 to :f1:$12.hex
cpm
objcpm b:$11
era b:$1*.mod
era b:$1*.
pip b:$1.hex=b:$11.hex,b:$12.hex
era b:$11.hex
era b:$12.hex
genmod b:$1.hex b:$1.prl
era b:*.hex
pip lst:=b:$1.lst
pip lst:=b:$11.sym[pt8]
pip lst:=b:$11.lin[pt8]


View File

@@ -0,0 +1,26 @@
era b:*.lst
era b:*.lin
era b:*.sym
era b:*.bak
isdd
;plm80 :f1:$1.plm pagewidth(80) debug nolist
link :f1:$1.obj,:f1:x0100,plm80.lib to :f1:$11.mod
locate :f1:$11.mod code(0100H) stacksize(100)
era b:$11.mod
objhex :f1:$11 to :f1:$11.hex
link :f1:$1.obj,:f1:x0200,plm80.lib to :f1:$12.mod
locate :f1:$12.mod code(0200H) stacksize(100)
era b:$12.mod
objhex :f1:$12 to :f1:$12.hex
era b:$12
cpm
objcpm b:$11
era b:$1*.
pip b:$1.hex=b:$11.hex,b:$12.hex
era b:$11.hex
era b:$12.hex
genmod b:$1.hex b:$1.prl
era b:*.hex
;pip lst:=b:$11.sym[pt8]
;pip lst:=b:$11.lin[pt8]