Upload

Digital Research

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as0com.asm

@@ -0,0 +1,52 @@
+	TITLE	'ASM COMMON DATA AREA'
+;
+;	COPYRIGHT (C) 1977, 1978, 1979, 1980, 1981
+;	DIGITAL RESEARCH
+;	BOX 579, PACIFIC GROVE
+;	CALIFORNIA, 93950
+;
+;	Revised:
+;	  14 Sept 81  by Thomas Rolander
+;
+;	COMMON DATA FOR MP/M ASSEMBLER MODULE
+	org	0
+base	equ	$
+
+	ORG	100H
+ENDA	EQU	base+20F0H	;END OF ASSEMBLER PROGRAM
+BDOS	EQU	base+5H	;ENTRY TO DOS, USED TO COMPUTE END MEMORY
+	LXI	SP,ENDMOD
+	LHLD	BDOS+1
+	SHLD	SYMAX	;COMPUTE END OF MEMORY
+	JMP	ENDMOD
+COPY:	DB	' COPYRIGHT(C) 1981, DIGITAL RESEARCH '
+	org	10ch
+;
+;	PRINT BUFFER AND PRINT BUFFER POINTER
+PBMAX	EQU	90	;MAX PRINT BUFFER
+PBUFF:	DS	PBMAX
+PBP:	DS	1	;PRINT BUFFER POINTER
+;
+;	SCANNER PARAMETERS
+TOKEN:	DS	1	;CURRENT TOKEN
+VALUE:	DS	2	;BINARY VALUE FOR NUMBERS
+ACCLEN:	DS	1	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;LENGTH OF ACCUMULATOR
+ACCUM:	DS	ACMAX	;ACCUMULATOR (MUST FOLLLOW ACCLEN)
+;
+;	OPERAND EXPRESSION EVALUATOR PARAMETERS
+EVALUE:	DS	2	;VALUE OF EXPRESSION AFTER EVALUATION
+;
+;	SYMBOL TABLE  MODULE PARAMETERS
+SYTOP:	DW	ENDA	;FIRST LOCATION AVAILABLE FOR SYMBOL TABLE
+SYMAX:	DS	2	;LAST AVAILABLE LOCATION FOR SYMBOL TABLE
+;
+;	MISCELLANEOUS DATA AREAS
+PASS:	DS	1	;PASS # 0,1
+FPC:	DS	2	;FILL ADDRESS FOR NEXT HEX RECORD
+ASPC:	DS	2	;ASSEMBLER'S PSEUDO PC
+SYBAS:	DW	ENDA	;SYMBOL TABLE BASE
+SYADR:	DS	2	;CURRENT SYMBOL BASE
+ENDMOD	EQU	($ AND 0FF00H)+100H
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as1io.asm

@@ -0,0 +1,730 @@
+	TITLE	'ASM IO MODULE'
+;	I/O MODULE FOR MP/M ASSEMBLER
+;
+	org	0
+base	equ	$
+
+	ORG	200H
+BOOT	EQU	base+00H	;REBOOT LOCATION
+;	I/O MODULE ENTRY POINTS
+	JMP	INIT	;INITIALIZE, START ASSEMBLER
+	JMP	SETUP	;FILE SETUP
+	JMP	GNC	;GET NEXT CHARACTER
+	JMP	PNC	;PUT NEXT OUTPUT CHARACTER
+	JMP	PNB	;PUT NEXT HEX BYTE
+	JMP	PCHAR	;PRINT CONSOLE CHARACTER
+	JMP	PCON	;PRINT CONSOLE BUFFER TO CRLF
+	JMP	WOBUFF	;WRITE OUTBUFFER
+	JMP	PERR	;PLACE ERROR CHARACTER INTO PBUFF
+	JMP	DHEX	;PLACE HEX BYTE INTO OUTPUT BUFFER
+	JMP	EOR	;END OF ASSEMBLY
+;	DATA FOR I/O MODULE
+BPC:	DS	2	;BASE PC FOR CURRENT HEX RECORD
+DBL:	DS	1	;HEX BUFFER LENGTH
+DBUFF:	DS	16	;HEX BUFFER
+;
+;	DISK NAMES
+CDISK:	DS	1	;CURRENTLY SELECTED DISK
+ADISK:	DS	1	;.ASM DISK
+PDISK:	DS	1	;.PRN DISK
+HDISK:	DS	1	;.HEX DISK
+;
+;
+;
+;	COMMON EQUATES
+QBMAX	EQU	90	;MAX PRINT SIZE
+QBUFF	EQU	base+10CH	;PRINT BUFFER
+QBP	EQU	QBUFF+QBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	QBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR DHEX ROUTINE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+;
+CR	EQU	0DH	;CARRIAGE RETURN
+LF	EQU	0AH	;LINE FEED
+EOF	EQU	1AH	;END OF FILE MARK
+;
+;
+;	DOS ENTRY POINTS
+BDOS	EQU	base+5H	;DOS ENTRY POINT
+READC	EQU	1	;READ CONSOLE DEVICE
+WRITC	EQU	2	;WRITE CONSOLE DEVICE
+REDYC	EQU	11	;CONSOLE CHARACTER READY
+SELECT	EQU	14	;SELECT DISK SPECIFIED BY REGISTER E
+OPENF	EQU	15	;OPEN FILE
+CLOSF	EQU	16	;CLOSE FILE
+DELEF	EQU	19	;DELETE FILE
+READF	EQU	20	;READ FILE
+WRITF	EQU	21	;WRITE FILE
+MAKEF	EQU	22	;MAKE A FILE
+CSEL	EQU	25	;RETURN CURRENTLY SELECTED DISK
+SETDM	EQU	26	;SET DMA ADDRESS
+;
+;	FILE AND BUFFERING PARAMETERS
+NSB	EQU	8	;NUMBER OF SOURCE BUFFERS
+NPB	EQU	6	;NUMBER OF PRINT BUFFERS
+NHB	EQU	6	;NUMBER OF HEX BUFFERS
+;
+SSIZE	EQU	NSB*128
+PSIZE	EQU	NPB*128
+HSIZE	EQU	NHB*128
+;
+;	FILE CONTROL BLOCKS
+SCB:	DS	9	;FILE NAME
+	DB	'ASM'	;FILE TYPE
+SCBR:	DS	1	;REEL NUMBER (ZEROED IN SETUP)
+	DS	19	;MISC AND DISK MAP
+SCBCR:	DS	1	;CURRENT RECORD (ZEROED IN SETUP)
+;
+PCB:	DS	9
+	DB	'PRN',0
+	DS	19
+	DB	0	;RECORD TO WRITE NEXT
+;
+HCB:	DS	9
+	DB	'HEX',0
+	DS	19
+	DB	0
+;
+;	POINTERS AND BUFFERS
+SBP:	DW	SSIZE	;NEXT CHARACTER POSITION TO READ
+SBUFF:	DS	SSIZE
+;
+PBP:	DW	0
+PBUFF:	DS	PSIZE
+;
+HBP:	DW	0
+HBUFF:	DS	HSIZE
+FCB	EQU	base+5CH	;FILE CONTROL BLOCK ADDRESS
+FNM	EQU	1	;POSITION OF FILE NAME
+FLN	EQU	9	;FILE NAME LENGTH
+BUFF	EQU	base+80H	;INPUT DISK BUFFER ADDRESS
+;
+SEL:	;SELECT DISK IN REG-A
+	LXI	H,CDISK
+	CMP	M	;SAME?
+	RZ
+	MOV	M,A	;CHANGE CURRENT DISK
+	MOV	E,A
+	MVI	C,SELECT
+	CALL	BDOS
+	RET
+;
+SCNP:	;SCAN THE NEXT PARAMETER
+	INX	H
+	MOV	A,M
+	CPI	' '
+	JZ	SCNP0
+	SBI	'A'	;NORMALIZE
+	RET
+SCNP0:	LDA	CDISK
+	RET
+;
+PCON:	;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
+	MOV	A,M
+	CALL	PCHAR
+	MOV	A,M
+	INX	H
+	CPI	CR
+	JNZ	PCON
+	MVI	A,LF
+	CALL	PCHAR
+	RET
+;
+FNAME:	;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
+	LXI	D,FCB
+	MVI	B,FLN
+FNAM0:	LDAX	D	;GET NEXT FILE CHARACTER
+	CPI	'?'
+	JZ	FNERR	;FILE NAME ERROR
+	MOV	M,A	;STORE TO FILE CNTRL BLOCK
+	INX	H
+	INX	D
+	DCR	B
+	JNZ	FNAM0	;FOR NEXT CHARACTER
+	RET
+;
+INIT:	;SET UP STACK AND FILES, START ASSEMBLER
+	LXI	H,TITL
+	CALL	PCON
+	JMP	SET0
+;
+OPEN:	;OPEN FILE ADDRESSED BY D,E
+	MVI	C,OPENF
+	CALL	BDOS
+	CPI	255
+	RNZ
+;	OPEN ERROR
+	LXI	H,ERROP
+	CALL	PCON
+	JMP	BOOT
+;
+CLOSE:	;CLOSE FILE ADDRESSED BY D,E
+	MVI	C,CLOSF
+	CALL	BDOS
+	CPI	255
+	RNZ		;CLOSE OK
+	LXI	H,ERRCL
+	CALL	PCON
+	JMP	BOOT
+;
+DELETE:	;DELETE FILE ADDRESSED BY D,E
+	MVI	C,DELEF
+	JMP	BDOS
+;
+MAKE:	;MAKE FILE ADDRESSED BY D,E
+	MVI	C,MAKEF
+	CALL	BDOS
+	CPI	255
+	RNZ
+;	MAKE ERROR
+	LXI	H,ERRMA
+	CALL	PCON
+	JMP	BOOT
+;
+SELA:	LDA	ADISK
+	CALL	SEL
+	RET
+;
+NPR:	;RETURN ZERO FLAG IF NO PRINT FILE
+	LDA	PDISK
+	CPI	'Z'-'A'
+	RZ
+	CPI	'X'-'A'	;CONSOLE
+	RET
+;
+SELP:	LDA	PDISK
+	CALL	SEL
+	RET
+;
+SELH:	LDA	HDISK
+	CALL	SEL
+	RET
+;
+SET0:	;SET UP FILES FOR INPUT AND OUTPUT
+	LDA	FCB	;GET FIRST CHARACTER
+	CPI	' '	;MAY HAVE FORGOTTEN NAME
+	JZ	FNERR	;FILE NAME ERROR
+	MVI	C,CSEL	;CURRENT DISK?
+	CALL	BDOS	;GET IT TO REG-A
+	STA	CDISK
+;
+;	SCAN PARAMETERS
+	LXI	H,FCB+FLN-1
+	CALL	SCNP
+	STA	ADISK
+	CALL	SCNP
+	STA	HDISK
+	CALL	SCNP
+	STA	PDISK
+;
+	LXI	H,SCB	;ADDRESS SOURCE FILE CONTROL BLOCK
+	CALL	FNAME		;FILE NAME OBTAINED FROM DEFAULT FCB
+;
+	CALL	NPR	;Z OR X?
+	JZ	NOPR
+	LXI	H,PCB	;ADDRESS PRINT FILE CONTROL BLOCK
+	PUSH	H	;SAVE A COPY FOR OPEN
+	PUSH	H	;SAVE A COPY FOR DELETE
+	CALL	FNAME	;FILL PCB
+	CALL	SELP
+	POP	D	;FCB ADDRESS
+	CALL	DELETE
+	POP	D	;FCB ADDRESS
+	CALL	MAKE
+;
+NOPR:	;TEST FOR HEX FILE
+	LDA	HDISK
+	CPI	'Z'-'A'
+	JZ	NOHEX
+	LXI	H,HCB
+	PUSH	H
+	PUSH	H
+	CALL	FNAME
+	CALL	SELH
+	POP	D
+	CALL	DELETE
+	POP	D
+	CALL	MAKE
+;
+;	FILES SET UP, CALL ASSEMBLER
+NOHEX:	JMP	ENDMOD
+;
+SETUP:	;SETUP INPUT FILE FOR SOURCE PROGRAM
+	LXI	H,SSIZE
+	SHLD	SBP	;CAUSE IMMEDIATE READ
+	XRA	A	;ZERO VALUE
+	STA	SCBR	;CLEAR REEL NUMBER
+	STA	SCBCR		;CLEAR CURRENT RECORD
+	STA	DBL		;CLEAR HEX BUFFER LENGTH
+	CALL	SELA
+	LXI	D,SCB
+	CALL	OPEN
+;
+	RET
+;
+FNERR:	;FILE NAME ERROR
+	LXI	H,ERRFN
+	CALL	PCON
+	JMP	BOOT
+;
+;
+GCOMP:	;COMPARE D,E AGAINS H,L
+	MOV	A,D
+	CMP	H
+	RNZ
+	MOV	A,E
+	CMP	L
+	RET
+;
+GNC:	;GET NEXT CHARACTER FROM SOURCE BUFFER
+	PUSH	B
+	PUSH	D
+	PUSH	H	;ENVIRONMENT SAVED
+	LHLD	SBP
+	LXI	D,SSIZE
+	CALL	GCOMP
+	JNZ	GNC2
+;
+;	READ ANOTHER BUFFER
+	CALL	SELA
+	LXI	H,0
+	SHLD	SBP
+	MVI	B,NSB	;NUMBER OF SOURCE BUFFERS
+	LXI	H,SBUFF
+GNC0:	;READ 128 BYTES
+	PUSH	B	;SAVE COUNT
+	PUSH	H	;SAVE BUFFER ADDRESS
+	MVI	C,READF
+	LXI	D,SCB
+	CALL	BDOS	;PERFORM THE READ
+	POP	H	;RESTORE BUFFER ADDRESS
+	POP	B	;RESTORE BUFFER COUNT
+	ORA	A	;SET FLAGS
+	MVI	C,128
+	JNZ	GNC1
+;	NORMAL READ OCCURRED
+	LXI	D,BUFF	;SOURCE BUFFER ADDRESS
+	MVI	C,128
+MOV0:	LDAX	D	;GET CHARACTER
+	MOV	M,A	;STORE CHARACTER
+	INX	D
+	INX	H
+	DCR	C
+	JNZ	MOV0
+;	BUFFER LOADED, TRY NEXT BUFFER
+;
+	DCR	B
+	JNZ	GNC0
+	JMP	GNC2
+;
+GNC1:	;EOF OR ERROR
+	CPI	3	;ALLOW 0,1,2
+	JNC	FRERR	;FILE READ ERROR
+GNCE:	MVI	M,EOF	;STORE AND END OF FILE CHARACTER
+	INX	H
+	DCR	C
+	JNZ	GNCE	;FILL CURRENT BUFFER WITH EOF'S
+;
+GNC2:	;GET CHARACTER TO ACCUMULATOR AND RETURN
+	LXI	D,SBUFF
+	LHLD	SBP
+	PUSH	H	;SAVE CURRENT SBP
+	INX	H	;READY FOR NEXT READ
+	SHLD	SBP
+	POP	H	;RESTORE PREVIOUS SBP
+	DAD	D	;ABSOLUTE ADDRESS OF CHARACTER
+	MOV	A,M	;GET IT
+	POP	H
+	POP	D
+	POP	B
+	RET
+;
+FRERR:	LXI	H,ERRFR
+	CALL	PCON	;PRINT READ ERROR MESSAGE
+	JMP	BOOT
+;
+PNC:	;SAME AT PNCF, BUT ENVIRONMENT IS SAVED FIRST
+	PUSH	B
+;	CHECK FOR CONSOLE OUTPUT / NO OUTPUT
+	MOV	B,A	;SAVE CHARACTER
+	LDA	PDISK	;Z OR X?
+	CPI	'Z'-'A'	;Z NO OUTPUT
+	JZ	PNRET
+;
+	CPI	'X'-'A'
+	MOV	A,B	;RECOVER CHAR FOR CON OUT
+	JNZ	PNGO
+	CALL	PCHAR
+	JMP	PNRET
+;
+;	NOT X OR Z, SO PRINT IT
+PNGO:	PUSH	D
+	PUSH	H
+	CALL	PNCF
+	POP	H
+	POP	D
+PNRET:	POP	B
+	RET
+;
+PNCF:	;PRINT NEXT CHARACTER
+	LHLD	PBP
+	XCHG
+	LXI	H,PBUFF
+	DAD	D
+	MOV	M,A	;CHARACTER STORED AT PBP IN PBUFF
+	XCHG		;PBP TO H,L
+	INX	H	;POINT TO NEXT CHARACTER
+	SHLD	PBP	;REPLACE IT
+	XCHG
+	LXI	H,PSIZE
+	CALL	GCOMP	;AT END OF BUFFER?
+	RNZ		;RETURN IF NOT
+;
+;	OVERFLOW, WRITE BUFFER
+	CALL	SELP
+	LXI	H,0
+	SHLD	PBP
+	LXI	H,PBUFF
+	LXI	D,PCB	;D,E ADDRESS FILE CONTROL BLOCK
+	MVI	B,NPB	;NUMBER OF BUFFERS TO B
+;	(DROP THROUGH TO WBUFF)
+;
+WBUFF:	;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
+;	CHECK FOR EOF'S
+	MOV	A,M
+	CPI	EOF
+	RZ		;DON'T DO THE WRITE
+;
+	PUSH	B	;SAVE NUMBER OF BUFFERS
+	PUSH	D	;SAVE FCB ADDRESS
+	MVI	C,128	;READY FOR MOVE
+	LXI	D,BUFF
+WBUF0:	;MOVE TO BUFFER
+	MOV	A,M	;GET CHARACTER
+	STAX	D	;PUT CHARACTER
+	INX	H
+	INX	D
+	DCR	C
+	JNZ	WBUF0
+;
+;	WRITE BUFFER
+	POP	D	;RECOVER FCB ADDRESS
+	PUSH	D	;SAVE IT AGAIN FOR LATER
+	PUSH	H	;SAVE BUFFER ADDRESS
+	MVI	C,WRITF	;DOS WRITE FUNCTION
+	CALL	BDOS
+	POP	H	;RECOVER BUFFER ADDRESS
+	POP	D	;RECOVER FCB ADDRESS
+	POP	B	;RECOVER BUFFER COUNT
+	ORA	A	;SET ERROR RETURN FLAGS
+	JNZ	FWERR
+;
+;	WRITE OK
+	DCR	B
+	RZ		;RETURN IF NO MORE BUFFERS TO WRITE
+	JMP	WBUFF
+;
+FWERR:	;ERROR IN WRITE
+	LXI	H,ERRFW
+	CALL	PCON	;ERROR MESSAGE OUT
+	JMP	EORC	;TO CLOSE AND REBOOT
+;
+;
+PNB:	;PUT NEXT HEX BYTE
+	PUSH	B
+	PUSH	D
+	PUSH	H
+	CALL	PNBF
+	POP	H
+	POP	D
+	POP	B
+	RET
+;
+PNBF:	;PUT NEXT BYTE
+;	(SIMILAR TO THE PNCF SUBROUTINE)
+	LHLD	HBP
+	XCHG
+	LXI	H,HBUFF
+	DAD	D
+	MOV	M,A	;CHARACTER STORED AT HBP IN HBUFF
+	XCHG
+	INX	H	;HBP INCREMENTED
+	SHLD	HBP
+	XCHG		;BACK TO D,E
+	LXI	H,HSIZE
+	CALL	GCOMP	;EQUAL?
+	RNZ
+;
+;	OVERFLOW, WRITE BUFFERS
+	CALL	SELH
+	LXI	H,0
+	SHLD	HBP
+	LXI	H,HBUFF
+	LXI	D,HCB	;FILE CONTROL BLOCK FOR HEX FILE
+	MVI	B,NHB
+	JMP	WBUFF	;WRITE BUFFERS
+;
+PCHAR:	;PRINT CHARACTER IN REGISTER A
+	PUSH	B
+	PUSH	D
+	PUSH	H
+	MVI	C,WRITC
+	MOV	E,A
+	CALL	BDOS
+	POP	H
+	POP	D
+	POP	B
+	RET
+;
+WOCHAR:	;WRITE CHARACTER IN REG-A WITH REFLECT AT CONSOLE IF ERROR
+	MOV	C,A	;SAVE THE CHAR
+	CALL	PNC	;PRINT CHAR
+	LDA	QBUFF
+	CPI	' '
+	RZ
+;	ERROR IN LINE
+	LDA	PDISK
+	CPI	'X'-'A'
+	RZ		;ALREADY PRINTED IF 'X'
+;
+	MOV	A,C	;RECOVER CHARACTER
+	CALL	PCHAR	;PRINT IT
+	RET
+;
+WOBUFF:	;WRITE THE OUTPUT BUFFER TO THE PRINT FILE
+	LDA	QBP	;GET CHARACTER COUNT
+	LXI	H,QBUFF	;BASE OF BUFFER
+WOB0:	ORA	A	;ZERO COUNT?
+	JZ	WOBE
+;	NOT END, SAVE COUNT AND GET CHARACTER
+	MOV	B,A	;SAVE COUNT
+	MOV	A,M
+	CALL	WOCHAR	;WRITE CHARACTER
+	INX	H	;ADDRESS NEXT CHARACTER OF BUFFER
+	MOV	A,B	;GET COUNT
+	DCR	A
+	JMP	WOB0
+;
+WOBE:	;END OF PRINT - ZERO QBP
+	STA	QBP
+;	FOLLOW BY CR LF
+	MVI	A,CR
+	CALL	WOCHAR
+	MVI	A,LF
+	CALL	WOCHAR
+	LXI	H,QBUFF
+	MVI	A,QBMAX	;READY TO BLANK OUT
+WOB2:	MVI	M,' '
+	INX	H
+	DCR	A
+	JNZ	WOB2
+	RET
+;
+;
+PERR:	;FILL QBUFF ERROR MESSAGE POSITION
+	MOV	B,A	;SAVE CHARACTER
+	LXI	H,QBUFF
+	MOV	A,M
+	CPI	' '
+	RNZ	;DON'T CHANGE IT IF ALREADY SET
+	MOV	M,B	;STORE ERROR CHARACTER
+	RET
+;
+EOR:	;END OF ASSEMBLER
+	CALL	NPR	;Z OR A?
+	JZ	EOPR
+;	FILL OUTPUT FILES WITH EOF'S
+EOR2:	LHLD	PBP
+	MOV	A,L
+	ORA	H	;VALUE ZERO?
+	JZ	EOPR
+	MVI	A,EOF	;CTL-Z IS END OF FILE
+	CALL	PNC	;PUT ENDFILES IN PRINT BUFFER
+	JMP	EOR2	;EVENTUALLY BUFFER IS WRITTEN
+;
+EOPR:	;END OF PRINT FILE, CHECK HEX
+	LDA	HDISK
+	CPI	'Z'-'A'
+	JZ	EORC
+EOR0:	;WRITE TERMINATING RECORD INTO HEX FILE
+	LDA	DBL	;MAY BE ZERO ALREADY
+	ORA	A
+	CNZ	WHEX	;WRITE HEX BUFFER IF NOT ZERO
+	LHLD	FPC	;GET CURRENT FPC AS LAST ADDRESS
+	SHLD	BPC	;RECORD LENGTH ZERO, BASE ADDRESS 0000
+	CALL	WHEX	;WRITE HEX BUFFER
+;
+;	NOW CLEAR OUTPUT BUFFER FOR HEX FILE
+EOR1:	LHLD	HBP
+	MOV	A,L
+	ORA	H
+	JZ	EORC
+	MVI	A,EOF
+	CALL	PNB
+	JMP	EOR1
+;
+;	CLOSE FILES AND TERMINATE
+EORC:
+	CALL	NPR
+	JZ	EORPC
+	CALL	SELP
+	LXI	D,PCB
+	CALL	CLOSE
+EORPC:
+	LDA	HDISK
+	CPI	'Z'-'A'
+	JZ	EORHC
+	CALL	SELH
+	LXI	D,HCB
+	CALL	CLOSE
+;
+EORHC:
+	LXI	H,ENDA
+	CALL	PCON
+	JMP	BOOT
+;
+TITL:	DB	'MP/M ASSEMBLER - VER 2.0',CR
+ERROP:	DB	'NO SOURCE FILE PRESENT',CR
+ERRMA:	DB	'NO DIRECTORY SPACE',CR
+ERRFN:	DB	'SOURCE FILE NAME ERROR',CR
+ERRFR:	DB	'SOURCE FILE READ ERROR',CR
+ERRFW:	DB	'OUTPUT FILE WRITE ERROR',CR
+ERRCL:	DB	'CANNOT CLOSE FILES',CR
+ENDA:	DB	'END OF ASSEMBLY',CR
+;
+DHEX:	;DATA TO HEX BUFFER (BYTE IN REG-A)
+	PUSH	B
+	MOV	B,A	;HOLD CHARACTER FOR 'Z' TEST
+	LDA	HDISK
+	CPI	'Z'-'A'
+	MOV	A,B	;RECOVER CHARACTER
+	JZ	DHRET
+	PUSH	D	;ENVIRONMENT SAVED
+	PUSH	PSW	;SAVE DATA BYTE
+	LXI	H,DBL	;CURRENT LENGTH
+	MOV	A,M	;TO ACCUM
+	ORA	A	;ZERO?
+	JZ	DHEX3
+;
+;	LENGTH NOT ZERO, MAY BE FULL BUFFER
+	CPI	16
+	JC	DHEX1	;BR IF LESS THAN 16 BYTES
+;	BUFFER FULL, DUMP IT
+	CALL	WHEX	;DBL = 0 UPON RETURN
+	JMP	DHEX3	;SET BPC AND DATA BYTE
+;
+DHEX1:	;PARTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
+	LHLD	FPC
+	XCHG
+	LHLD	BPC	;BASE PC IN H,L
+	MOV	C,A	;CURRENT LENGTH OF BUFFER
+	MVI	B,0	;IS IN B,C
+	DAD	B	;BPC+DBL TO H,L
+	MOV	A,E	;READY FOR COMPARE
+	CMP	L	;EQUAL?
+	JNZ	DHEX2	;BR IF NOT
+	MOV	A,D	;CHECK HO BYTE
+	CMP	H
+	JZ	DHEX4	;BR IF SAME ADDRESS
+;
+DHEX2:	;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
+	CALL	WHEX
+DHEX3:	;SET NEW BASE
+	LHLD	FPC
+	SHLD	BPC
+;
+DHEX4:	;STORE DATA BYTE AND INC DBL
+	LXI	H,DBL
+	MOV	E,M	;LENGTH TO REG-E
+	INR	M	;DBL=DBL+1
+	MVI	D,0	;HIGH ORDER ZERO FOR DOUBLE ADD
+	LXI	H,DBUFF
+	DAD	D	;DBUFF+DBL TO H,L
+	POP	PSW	;RESTORE DATA BYTE
+	MOV	M,A	;INTO DATA BUFFER
+	POP	D
+DHRET:	POP	B	;ENVIRONMENT RESTORED
+	RET
+;
+WRC:	;WRITE CHARACTER WITH CHECK SUM IN D
+	PUSH	PSW
+	RRC
+	RRC
+	RRC
+	RRC
+	ANI	0FH
+	CALL	HEXC	;OUTPUT HEX CHARACTER
+	POP	PSW	;RESTORE BYTE
+	PUSH	PSW	;SAVE A VERSION
+	ANI	0FH
+	CALL	HEXC	;WRITE LOW NIBBLE
+	POP	PSW	;RESTORE BYTE
+	ADD	D	;COMPUTE CHECKSUM
+	MOV	D,A	;SAVE CS
+	RET
+;
+HEXC:	;WRITE CHARACTER
+	ADI	90H
+	DAA
+	ACI	40H
+	DAA
+	JMP	PNB	;PUT BYTE
+;
+WHEX:	;WRITE CURRENT HEX BUFFER
+	MVI	A,':'	;RECORD HEADER
+	CALL	PNB	;PUT BYTE
+	LXI	H,DBL	;RECORD LENGTH ADDRESS
+	MOV	E,M	;LENGTH TO REG-E
+	XRA	A	;ZERO TO REG-A
+	MOV	D,A	;CLEAR CHECKSUM
+	MOV	M,A	;LENGTH IS ZEROED FOR NEXT WRITE
+	LHLD	BPC	;BASE ADDRESS FOR RECORD
+	MOV	A,E	;LENGTH TO A
+	CALL	WRC	;WRITE HEX VALUE
+	MOV	A,H	;HIGH ORDER BASE ADDR
+	CALL	WRC	;WRITE HO BYTE
+	MOV	A,L	;LOW ORDER BASE ADDR
+	CALL	WRC	;WRITE LO BYTE
+	XRA	A	;ZERO TO A
+	CALL	WRC	;WRITE RECORD TYPE 00
+	MOV	A,E	;CHECK FOR LENGTH 0
+	ORA	A
+	JZ	WHEX1
+;
+;	NON - ZERO, WRITE DATA BYTES
+	LXI	H,DBUFF
+WHEX0:	MOV	A,M	;GET BYTE
+	INX	H
+	CALL	WRC	;WRITE DATA BYTE
+	DCR	E	;END OF BUFFER?
+	JNZ	WHEX0
+;
+;	END OF DATA BYTES, WRITE CHECK SUM
+WHEX1:	XRA	A
+	SUB	D	;COMPUTE CHECKSUM
+	CALL	WRC
+;
+;	SEND CRLF AT END OF RECORD
+	MVI	A,CR
+	CALL	PNB
+	MVI	A,LF
+	CALL	PNB
+	RET
+;
+;
+;
+ENDMOD	EQU	($ AND 0FFE0H)+20H
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as2scan.asm

@@ -0,0 +1,412 @@
+	TITLE	'ASM SCANNER MODULE'
+	org	0
+base	equ	$
+
+	ORG	1100H
+	JMP	ENDMOD	;END OF THIS MODULE
+	JMP	INITS	;INITIALIZE THE SCANNER
+	JMP	SCAN	;CALL THE SCANNER
+;
+;
+;	ENTRY POINTS IN I/O MODULE
+IOMOD	EQU	base+200H
+GNCF	EQU	IOMOD+6H
+WOBUFF	EQU	IOMOD+15H
+PERR	EQU	IOMOD+18H
+;
+LASTC:	DS	1	;LAST CHAR SCANNED
+NEXTC:	DS	1	;LOOK AHEAD CHAR
+STYPE:	DS	1	;RADIX INDICATOR
+;
+;	COMMON EQUATES
+PBMAX	EQU	90	;MAX PRINT SIZE
+PBUFF	EQU	base+10CH	;PRINT BUFFER
+PBP	EQU	PBUFF+PBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	PBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR NEXT HEX BYTE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+;
+;	GLOBAL EQUATES
+IDEN	EQU	1	;IDENTIFIER
+NUMB	EQU	2	;NUMBER
+STRNG	EQU	3	;STRING
+SPECL	EQU	4	;SPECIAL CHARACTER
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL
+;
+BINV	EQU	2
+OCTV	EQU	8
+DECV	EQU	10
+HEXV	EQU	16
+CR	EQU	0DH
+LF	EQU	0AH
+EOF	EQU	1AH
+TAB	EQU	09H	;TAB CHARACTER
+;
+;
+;	UTILITY SUBROUTINES
+GNC:	;GET NEXT CHARACTER AND ECHO TO PRINT FILE
+	CALL	GNCF
+	PUSH	PSW
+	CPI	CR
+	JZ	GNC0
+	CPI	LF	;IF LF THEN DUMP CURRENT BUFFER
+	JZ	GNC0
+;
+	;NOT A CR OR LF, PLACE INTO BUFFER IF THERE IS ENOUGH ROOM
+	LDA	PBP
+	CPI	PBMAX
+	JNC	GNC0
+;	ENOUGH ROOM, PLACE INTO BUFFER
+	MOV	E,A
+	MVI	D,0	;DOUBLE PRECISION PBP IN D,E
+	INR	A
+	STA	PBP	;INCREMENTED PBP IN MEMORY
+	LXI	H,PBUFF
+	DAD	D	;PBUFF(PBP)
+	POP	PSW
+	MOV	M,A	;PBUFF(PBP) = CHAR
+	RET
+GNC0:	;CHAR NOT PLACED INTO BUFFER
+	POP	PSW
+	RET
+;
+INITS:	;INITIALIZE THE SCANNER
+	CALL	ZERO
+	STA	NEXTC	;CLEAR NEXT CHARACTER
+	STA	PBP
+	MVI	A,LF	;SET LAST CHAR TO LF
+	STA	LASTC
+	CALL	WOBUFF	;CLEAR BUFFER
+	MVI	A,16	;START OF PRINT LINE
+	STA	PBP
+	RET
+;
+ZERO:	XRA	A
+	STA	ACCLEN
+	STA	STYPE
+	RET
+;
+SAVER:	;STORE THE NEXT CHARACTER INTO THE ACCUMULATOR AND UPDATE ACCLEN
+	LXI	H,ACCLEN
+	MOV	A,M
+	CPI	ACMAX
+	JC	SAV1	;JUMP IF NOT UP TO LAST POSITION
+	MVI	M,0
+	CALL	ERRO
+SAV1:	MOV	E,M	;D,E WILL HOLD INDEX
+	MVI	D,0
+	INR	M	;ACCLEN INCREMENTED
+	INX	H	;ADDRESS ACCUMULATOR
+	DAD	D	;ADD INDEX TO ACCUMULATOR
+	LDA	NEXTC	;GET CHARACTER
+	MOV	M,A	;INTO ACCUMULATOR
+	RET
+;
+TDOLL:	;TEST FOR DOLLAR SIGN, ASSUMING H,L ADDRESS NEXTC
+	MOV	A,M
+	CPI	'$'
+	RNZ
+	XRA	A	;TO GET A ZERO
+	MOV	M,A	;CLEARS NEXTC
+	RET		;WITH ZERO FLAG SET
+;
+NUMERIC:	;CHECK NEXTC FOR NUMERIC, RETURN ZERO FLAG IF NOT NUMERIC
+	LDA	NEXTC
+	SUI	'0'
+	CPI	10
+;	CARRY RESET IF NUMERIC
+	RAL
+	ANI	1B	;ZERO IF NOT NUMERIC
+	RET
+;
+HEX:	;RETURN ZERO FLAG IF NEXTC IS NOT HEXADECIMAL
+	CALL	NUMERIC
+	RNZ		;RETURNS IF 0-9
+	LDA	NEXTC
+	SUI	'A'
+	CPI	6
+;	CARRY SET IF OUT OF RANGE
+	RAL
+	ANI	1B
+	RET
+;
+LETTER:	;RETURN ZERO FLAG IF NEXTC IS NOT A LETTER
+	LDA	NEXTC
+	SUI	'A'
+	CPI	26
+	RAL
+	ANI	1B
+	RET
+;
+ALNUM:	;RETURN ZERO FLAG IF NOT ALPHANUMERIC
+	CALL	LETTER
+	RNZ
+	CALL	NUMERIC
+	RET
+;
+TRANS:	;TRANSLATE TO UPPER CASE
+	LDA	NEXTC
+	CPI	'A' OR 1100000B	;LOWER CASE A
+	RC				;CARRY IF LESS THAN LOWER A
+	CPI	('Z' OR 1100000B)+1	;LOWER CASE Z
+	RNC				;NO CARRY IF GREATER THAN LOWER Z
+	ANI	1011111B		;CONVERT TO UPPER CASE
+	STA	NEXTC
+	RET
+;
+GNCN:	;GET CHARACTER AND STORE TO NEXTC
+	CALL	GNC
+	STA	NEXTC
+	push	psw	;*** Patch ***
+	lda	token	;Fixes upper case conversion
+	cpi	strng	;of characters in a string
+	cnz	TRANS	;TRANSLATE TO UPPER CASE
+	pop	psw
+	RET
+;
+EOLT:	;END OF LINE TEST FOR COMMENT SCAN
+	CPI	CR
+	RZ
+	CPI	EOF
+	RZ
+	CPI	'!'
+	RET
+;
+SCAN:	;FIND NEXT TOKEN IN INPUT STREAM
+	XRA	A
+	STA	TOKEN
+	CALL	ZERO
+;
+;	DEBLANK
+DEBL:	LDA	NEXTC
+	CPI	TAB	;TAB CHARACTER TREATED AS BLANK OUTSIDE STRING
+	JZ	DEB0
+	CPI	';'	;MAY BE A COMMENT
+	JZ	DEB1	;DEBLANK THROUGH COMMENT
+	CPI	'*'	;PROCESSOR TECH COMMENT
+	JNZ	DEB2	;NOT *
+	LDA	LASTC
+	CPI	LF	;LAST LINE FEED?
+	JNZ	DEB2	;NOT LF*
+;	COMMENT FOUND, REMOVE IT
+DEB1:	CALL	GNCN
+	CALL	EOLT	;CR, EOF, OR !
+	JZ	FINDL	;HANDLE END OF LINE
+	JMP	DEB1	;OTHERWISE CONTINUE SCAN
+DEB2:	ORI	' '	;MAY BE ZERO
+	CPI	' '
+	JNZ	FINDL
+DEB0:	CALL	GNCN	;GET NEXT AND STORE TO NEXTC
+	JMP	DEBL
+;
+;	LINE DEBLANKED, FIND TOKEN TYPE
+FINDL:	;LOOK FOR LETTER, DECIMAL DIGIT, OR STRING QUOTE
+	CALL	LETTER
+	JZ	FIND0
+	MVI	A,IDEN
+	JMP	STOKEN
+;
+FIND0:	CALL	NUMERIC
+	JZ	FIND1
+	MVI	A,NUMB
+	JMP	STOKEN
+;
+FIND1:	LDA	NEXTC
+	CPI	''''
+	JNZ	FIND2
+	XRA	A
+	STA	NEXTC	;DON'T STORE THE QUOTE
+	MVI	A,STRNG
+	JMP	STOKEN
+;
+FIND2:	;ASSUME IT IS A SPECIAL CHARACTER
+	CPI	LF	;IF LF THEN DUMP THE BUFFER
+	JNZ	FIND3
+;	LF FOUND
+	LDA	PASS
+	ORA	A
+	CNZ	WOBUFF
+	LXI	H,PBUFF	;CLEAR ERROR CHAR ON BOTH PASSES
+	MVI	M,' '
+	MVI	A,16
+	STA	PBP	;START NEW LINE
+FIND3:	MVI	A,SPECL
+;
+STOKEN:	STA	TOKEN
+;
+;
+;	LOOP WHILE CURRENT ITEM IS ACCUMULATING
+SCTOK:	LDA	NEXTC
+	STA	LASTC	;SAVE LAST CHARACTER
+	ORA	A
+	CNZ	SAVER	;STORE CHARACTER INTO ACCUM IF NOT ZERO
+	CALL	GNCN	;GET NEXT TO NEXTC
+	LDA	TOKEN
+	CPI	SPECL
+	RZ		;RETURN IF SPECIAL CHARACTER
+	CPI	STRNG
+	CNZ	TRANS	;TRANSLATE TO UPPER CASE IF NOT IN STRING
+	LXI	H,NEXTC
+	LDA	TOKEN
+;
+	CPI	IDEN
+	JNZ	SCT2
+;
+;	ACCUMULATING AN IDENTIFIER
+	CALL	TDOLL	;$?
+	JZ	SCTOK	;IF SO, SKIP IT
+	CALL	ALNUM	;ALPHA NUMERIC?
+	RZ		;RETURN IF END
+;	NOT END OF THE IDENTIFIER
+	JMP	SCTOK
+;
+SCT2:	;NOT SPECIAL OR IDENT, CHECK NUMBER
+	CPI	NUMB
+	JNZ	SCT3
+;
+;	ACCUMULATING A NUMBER, CHECK FOR $
+	CALL	TDOLL
+	JZ	SCTOK	;SKIP IF FOUND
+	CALL	HEX	;HEX CHARACTER?
+	JNZ	SCTOK	;STORE IT IF FOUND
+;	END OF NUMBER, LOOK FOR RADIX INDICATOR
+;
+	LDA	NEXTC
+	CPI	'O'	;OCTAL INDICATOR
+	JZ	NOCT
+	CPI	'Q'	;OCTAL INDICATOR
+	JNZ	NUM2
+;
+NOCT:	;OCTAL
+	MVI	A,OCTV
+	JMP	SSTYP
+;
+NUM2:	CPI	'H'
+	JNZ	NUM3
+	MVI	A,HEXV
+SSTYP:	STA	STYPE
+	XRA	A
+	STA	NEXTC	;CLEARS THE LOOKAHEAD CHARACTER
+	JMP	NCON
+;
+;	RADIX MUST COME FROM ACCUM
+NUM3:	LDA	LASTC
+	CPI	'B'
+	JNZ	NUM4
+	MVI	A,BINV
+	JMP	SSTY1
+;
+NUM4:	CPI	'D'
+	MVI	A,DECV
+	JNZ	SSTY2
+SSTY1:	LXI	H,ACCLEN
+	DCR	M	;ACCLEN DECREMENTED TO REMOVE RADIX INDICATOR
+SSTY2:	STA	STYPE
+;
+NCON:	;NUMERIC CONVERSION OCCURS HERE
+	LXI	H,0
+	SHLD	VALUE	;VALUE ACCUMULATES BINARY EQUIVALENT
+	LXI	H,ACCLEN
+	MOV	C,M	;C=ACCLEN
+	INX	H	;ADDRESSES ACCUM
+CLOP:	;NEXT DIGIT IS PROCESSED HERE
+	MOV	A,M
+	INX	H	;READY FOR NEXT LOOP
+	CPI	'A'
+	JNC	CLOP1	;NOT HEX A-F
+	SUI	'0'	;NORMALIZE
+	JMP	CLOP2
+;
+CLOP1:	;HEX A-F
+	SUI	'A'-10
+CLOP2:	;CHECK SIZE AGAINST RADIX
+	PUSH	H	;SAVE ACCUM ADDR
+	PUSH	B	;SAVE CURRENT POSITION
+	MOV	C,A
+	LXI	H,STYPE
+	CMP	M
+	CNC	ERRV	;VALUE ERROR IF DIGIT>=RADIX
+	MVI	B,0	;DOUBLE PRECISION DIGIT
+	MOV	A,M	;RADIX TO ACCUMULATOR
+	LHLD	VALUE
+	XCHG		;VALUE TO D,E - ACCUMULATE RESULT IN H,L
+	LXI	H,0	;ZERO ACCUMULATOR
+CLOP3:	;LOOP UNTIL RADIX GOES TO ZERO
+	ORA	A
+	JZ	CLOP4
+	RAR		;TEST LSB
+	JNC	TTWO	;SKIP SUMMING OPERATION IF LSB=0
+	DAD	D	;ADD IN VALUE
+TTWO:	;MULTIPLY VALUE * 2 FOR SHL OPERATION
+	XCHG
+	DAD	H
+	XCHG
+	JMP	CLOP3
+;
+;
+CLOP4:	;END OF NUMBER CONVERSION
+	DAD	B	;DIGIT ADDED IN
+	SHLD	VALUE
+	POP	B
+	POP	H
+	DCR	C	;MORE DIGITS?
+	JNZ	CLOP
+	RET		;DONE WITH THE NUMBER
+;
+SCT3:	;MUST BE A STRING
+	LDA	NEXTC
+	CPI	CR	;END OF LINE?
+	JZ	ERRO	;AND RETURN
+	CPI	''''
+	JNZ	SCTOK
+	CALL	GNCN
+	CPI	''''
+	RNZ		;RETURN IF SINGLE QUOTE ENCOUNTERED
+	JMP	SCTOK	;OTHERWISE TREAT AS ONE QUOTE
+;
+;	END OF SCANNER
+;
+;	ERROR MESSAGE ROUTINES
+ERRV:	;'V' VALUE ERROR
+	PUSH	PSW
+	MVI	A,'V'
+	JMP	ERR
+;
+ERRO:	;'O' OVERFLOW ERROR
+	PUSH	PSW
+	MVI	A,'O'
+	JMP	ERR
+;
+ERR:	;PRINT ERROR MESSAGE
+	PUSH	B
+	PUSH	H
+	CALL	PERR
+	POP	H
+	POP	B
+	POP	PSW
+	RET
+;
+ENDMOD	EQU	($ AND 0FFE0H) + 20H
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as3sym.asm

@@ -0,0 +1,385 @@
+	TITLE	'ASM SYMBOL TABLE MODULE'
+;	SYMBOL TABLE MANIPULATION MODULE
+;
+	org	0
+base	equ	$
+
+	ORG	1340H
+IOMOD	EQU	base+200H	;IO MODULE ENTRY POINT
+PCON	EQU	IOMOD+12H
+EOR	EQU	IOMOD+1EH
+;
+;
+;	ENTRY POINTS TO SYMBOL TABLE MODULE
+	JMP	ENDMOD
+	JMP	INISY
+	JMP	LOOKUP
+	JMP	FOUND
+	JMP	ENTER
+	JMP	SETTY
+	JMP	GETTY
+	JMP	SETVAL
+	JMP	GETVAL
+;
+;	COMMON EQUATES
+PBMAX	EQU	90	;MAX PRINT SIZE
+PBUFF	EQU	base+10CH	;PRINT BUFFER
+PBP	EQU	PBUFF+PBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	PBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR NEXT HEX BYTE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+SYBAS	EQU	ASPC+2	;BASE OF SYMBOL TABLE
+SYADR	EQU	SYBAS+2	;CURRENT SYMBOL BEING ACCESSED
+;
+;	GLOBAL EQUATES
+IDEN	EQU	1	;IDENTIFIER
+NUMB	EQU	2	;NUMBER
+STRNG	EQU	3	;STRING
+SPECL	EQU	4	;SPECIAL CHARACTER
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL
+;
+;
+CR	EQU	0DH
+;
+;	DATA AREAS
+;	SYMBOL TABLE BEGINS AT THE END OF THIS MODULE
+FIXD	EQU	5	;5 BYTES OVERHEAD WITH EACH SYMBOL ENTRY
+;			2BY COLLISION, 1BY TYPE/LEN, 2BY VALUE
+HSIZE	EQU	128	;HASH TABLE SIZE
+HMASK	EQU	HSIZE-1	;HASH MASK FOR CODING
+HASHT:	DS	HSIZE*2	;HASH TABLE
+HASHC:	DS	1	;HASH CODE AFTER CALL ON LOOKUP
+;
+;	SYMBOL TABLE ENTRY FORMAT IS
+;		-----------------
+;		: HIGH VAL BYTE	:
+;		-----------------
+;		: LOW  VAL BYTE	:
+;		-----------------
+;		: CHARACTER N	:
+;		-----------------
+;		:    ... 	:
+;		-----------------
+;		: CHARACTER 1	:
+;		-----------------
+;		: TYPE  : LENG	:
+;		-----------------
+;		: HIGH COLLISION:
+;		-----------------
+;	SYADR=	: LOW COLLISION :
+;		-----------------
+;
+;	WHERE THE LOW/HIGH COLLISION FIELD ADDRESSES ANOTHER ENTRY WITH
+;	THE SAME HASH CODE (OR ZERO IF THE END OF CHAIN), TYPE DESCRIBES
+;	THE ENTRY TYPE (GIVEN BELOW), LENG IS THE NUMBER OF CHARACTERS IN
+;	THE SYMBOL PRINTNAME -1 (I.E., LENG=0 IS A SINGLE CHARACTER PRINT-
+;	NAME, WHILE LENG=15 INDICATES A 16 CHARACTER NAME).  CHARACTER 1
+;	THROUGH N GIVE THE PRINTNAME CHARACTERS IN ASCII UPPER CASE (ALL
+;	LOWER CASE NAMES ARE TRANSLATED ON INPUT), AND THE LOW/HIGH VALUE
+;	GIVE THE PARTICULAR ADDRESS OR CONSTANT VALUE ASSOCIATED WITH THE
+;	NAME.  THE REPRESENTATION OF MACROS DIFFERS IN THE FIELDS WHICH
+;	FOLLOW THE VALUE FIELD (MACROS ARE NOT CURRENTLY IMPLEMENTED).
+;
+;	THE TYPE FIELD CONSISTS OF FOUR BITS WHICH ARE ASSIGNED AS
+;	FOLLOWS:
+;
+;		0000	UNDEFINED SYMBOL
+;		0001	LOCAL	LABELLED PROGRAM
+;		0010	LOCAL	LABELLED DATA
+;		0011	(UNUSED)
+;		0100		EQUATE
+;		0101		SET
+;		0110		MACRO
+;		0111		(UNUSED)
+;
+;		1000		(UNUSED)
+;		1001	EXTERN	LABELLED PROGRAM
+;		1010	EXTERN	LABELLED DATA
+;		1011		REFERENCE TO MODULE
+;		1100		(UNUSED)
+;		1101	GLOBAL	UNDEFINED SYMBOL
+;		1110	GLOBAL	LABELLED PROGRAM
+;		1111		(UNUSED)
+;
+;	TYPE DEFINITIONS
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL ATTRIBUTE
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL ATTRIBUTE
+;
+;
+INISY:	;INITIALIZE THE SYMBOL TABLE
+	LXI	H,HASHT	;ZERO THE HASH TABLE
+	MVI	B,HSIZE
+	XRA	A	;CLEAR ACCUM
+INI0:
+	MOV	M,A
+	INX	H
+	MOV	M,A	;CLEAR DOUBLE WORD
+	INX	H
+	DCR	B
+	JNZ	INI0
+;
+;	SET SYMBOL TABLE POINTERS
+	LXI	H,0
+	SHLD	SYADR
+;
+	RET
+;
+CHASH:	;COMPUTE HASH CODE FOR CURRENT ACCUMULATOR
+	LXI	H,ACCLEN
+	MOV	B,M	;GET ACCUM LENGTH
+	XRA	A	;CLEAR ACCUMULATOR
+CH0:	INX	H	;MOVE TO FIRST/NEXT CHARACTER POSITION
+	ADD	M	;ADD WITH OVERFLOW
+	DCR	B
+	JNZ	CH0
+	ANI	HMASK	;MASK BITS FOR MODULO HZISE
+	STA	HASHC	;FILL HASHC WITH RESULT
+	RET
+;
+SETLN:	;SET THE LENGTH FIELD OF THE CURRENT SYMBOL
+	MOV	B,A	;SAVE LENGTH IN B
+	LHLD	SYADR
+	INX	H
+	INX	H
+	MOV	A,M	;GET TYPE/LENGTH FIELD
+	ANI	0F0H	;MASK OUT TYPE FIELD
+	ORA	B	;MASK IN LENGTH
+	MOV	M,A
+	RET
+;
+GETLN:	;GET THE LENGTH FIELD TO REG-A
+	LHLD	SYADR
+	INX	H
+	INX	H
+	MOV	A,M
+	ANI	0FH
+	INR	A	;LENGTH IS STORED AS VALUE - 1
+	RET
+;
+FOUND:	;FOUND RETURNS TRUE IF SYADR IS NOT ZERO (TRUE IS NZ FLAG HERE)
+	LHLD	SYADR
+	MOV	A,L
+	ORA	H
+	RET
+;
+LOOKUP:	;LOOK FOR SYMBOL IN ACCUMULATOR
+	CALL	CHASH	;COMPUTE HASH CODE
+;	NORMALIZE IDENTIFIER TO 16 CHARACTERS
+	LXI	H,ACCLEN
+	MOV	A,M
+	CPI	17
+	JC	LENOK
+	MVI	M,16
+LENOK:
+;	LOOK FOR SYMBOL THROUGH HASH TABLE
+	LXI	H,HASHC
+	MOV	E,M
+	MVI	D,0	;DOUBLE HASH CODE IN D,E
+	LXI	H,HASHT	;BASE OF HASH TABLE
+	DAD	D
+	DAD	D	;HASHT(HASHC)
+	MOV	E,M	;LOW ORDER ADDRESS
+	INX	H
+	MOV	H,M
+	MOV	L,E	;HEADER TO LIST OF SYMBOLS IS IN H,L
+LOOK0:	SHLD	SYADR
+	CALL	FOUND
+	RZ		;RETURN IF SYADR BECOMES ZERO
+;
+;	OTHERWISE EXAMINE CHARACTER STRING FOR MATCH
+	CALL	GETLN	;GET LENGTH TO REG-A
+	LXI	H,ACCLEN
+	CMP	M
+	JNZ	LCOMP
+;
+;	LENGTH MATCH, TRY TO MATCH CHARACTERS
+	MOV	B,A	;STRING LENGTH IN B
+	INX	H	;HL ADDRESSES ACCUM
+	XCHG		;TO D,E
+	LHLD	SYADR
+	INX	H
+	INX	H
+	INX	H	;ADDRESSES CHARACTERS
+LOOK1:	LDAX	D	;NEXT CHARACTER FROM ACCUM
+	CMP	M	;NEXT CHARACTER IN SYMBOL TABLE
+	JNZ	LCOMP
+;	CHARACTER MATCHED, INCREMENT TO NEXT
+	INX	D
+	INX	H
+	DCR	B
+	JNZ	LOOK1
+;
+;	COMPLETE MATCH AT CURRENT SYMBOL, SYADR IS SET
+	RET
+;
+LCOMP:	;NOT FOUND, MOVE SYADR DOWN ONE COLLISION ADDRESS
+	LHLD	SYADR
+	MOV	E,M
+	INX	H
+	MOV	D,M	;COLLISION ADDRESS IN D,E
+	XCHG
+	JMP	LOOK0
+;
+;
+ENTER:	;ENTER SYMBOL IN ACCUMULATOR
+;	ENSURE THERE IS ENOUGH SPACE IN THE TABLE
+	LXI	H,ACCLEN
+	MOV	E,M
+	MVI	D,0	;DOUBLE PRECISION ACCLEN IN D,E
+	LHLD	SYTOP
+	SHLD	SYADR	;NEXT SYMBOL LOCATION
+	DAD	D	;SYTOP+ACCLEN
+	LXI	D,FIXD	;FIXED DATA/SYMBOL
+	DAD	D	;HL HAS NEXT TABLE LOCATION FOR SYMBOL
+	XCHG		;NEW SYTOP IN D,E
+	LHLD	SYMAX	;MAXIMUM SYMTOP VALUE
+	MOV	A,E
+	SUB	L	;COMPUTE 16-BIT DIFFERENCE
+	MOV	A,D
+	SBB	H
+	XCHG		;NEW SYTOP IN H,L
+	JNC	OVERER	;OVERFLOW IN TABLE
+;
+;	OTHERWISE NO ERROR
+	SHLD	SYTOP	;SET NEW TABLE TOP
+	LHLD	SYADR	;SET COLLISION FIELD
+	XCHG		;CURRENT SYMBOL ADDRESS TO D,E
+	LXI	H,HASHC	;HASH CODE FOR CURRENT SYMBOL TO H,L
+	MOV	C,M	;LOW BYTE
+	MVI	B,0	;DOUBLE PRECISION VALUE IN B,C
+	LXI	H,HASHT	;BASE OF HASH TABLE
+	DAD	B
+	DAD	B	;HASHT(HASHC) IN H,L
+;	D,E ADDRESSES CURRENT SYMBOL - CHANGE LINKS
+	MOV	C,M	;LOW ORDER OLD HEADER
+	INX	H
+	MOV	B,M	;HIGH ORDER OLD HEADER
+	MOV	M,D	;HIGH ORDER NEW HEADER TO HASH TABLE
+	DCX	H
+	MOV	M,E	;LOW ORDER NEW HEADER TO HASH TABLE
+	XCHG		;H,L HOLDS SYMBOL TABLE ADDRESS
+	MOV	M,C	;LOW ORDER OLD HEADER TO COLLISION FIELD
+	INX	H
+	MOV	M,B	;HIGH ORDER OLD HEADER TO COLLISION FIELD
+;
+;	HASH CHAIN NOW REPAIRED FOR THIS ENTRY, COPY THE PRINTNAME
+	LXI	D,ACCLEN
+	LDAX	D	;GET SYMBOL LENGTH
+	CPI	17	;LARGER THAN 16 SYMBOLS?
+	JC	ENT1
+	MVI	A,16	;TRUNCATE TO 16 CHARACTERS
+;	COPY LENGTH FIELD, FOLLOWED BY PRINTNAME CHARACTERS
+ENT1:	MOV	B,A	;COPY LENGTH TO B
+	DCR	A	;1-16 CHANGED TO 0-15
+	INX	H	;FOLLOWING COLLISION FIELD
+	MOV	M,A	;STORE LENGTH WITH UNDEFINED TYPE (0000)
+ENT2:	INX	H
+	INX	D
+	LDAX	D
+	MOV	M,A	;STORE NEXT CHARACTER OF PRINTNAME
+	DCR	B	;LENGTH=LENGTH-1
+	JNZ	ENT2	;FOR ANOTHER CHARACTER
+;
+;	PRINTNAME COPIED, ZERO THE VALUE FIELD
+	XRA	A	;ZERO A
+	INX	H	;LOW ORDER VALUE
+	MOV	M,A
+	INX	H
+	MOV	M,A	;HIGH ORDER VALUE
+	RET
+;
+OVERER:	;OVERFLOW IN SYMBOL TABLE
+	LXI	H,ERRO
+	CALL	PCON
+	JMP	EOR	;END OF EXECUTION
+ERRO:	DB	'SYMBOL TABLE OVERFLOW',CR
+;
+SETTY:	;SET CURRENT SYMBOL TYPE TO VALUE IN REG-A
+	RAL
+	RAL
+	RAL
+	RAL
+	ANI	0F0H	;TYPE MOVED TO HIGH ORDER 4-BITS
+	MOV	B,A	;SAVE IT IN B
+	LHLD	SYADR	;BASE OF SYMBOL TO ACCESS
+	INX	H
+	INX	H	;ADDRESS OF TYPE/LENGTH FIELD
+	MOV	A,M	;GET IT AND MASK
+	ANI	0FH	;LEAVE LENGTH
+	ORA	B	;MASK IN TYPE
+	MOV	M,A	;STORE IT
+	RET
+;
+GETTY:	;RETURN THE TYPE OF THE VALUE IN CURRENT SYMBOL
+	LHLD	SYADR
+	INX	H
+	INX	H
+	MOV	A,M
+	RAR
+	RAR
+	RAR
+	RAR
+	ANI	0FH	;TYPE MOVED TO LOW 4-BITS OF REG-A
+	RET
+;
+VALADR:	;GET VALUE FIELD ADDRESS FOR CURRENT SYMBOL
+	CALL	GETLN	;PRINTNAME LENGTH TO ACCUM
+	LHLD	SYADR	;BASE ADDRESS
+	MOV	E,A
+	MVI	D,0
+	DAD	D	;BASE(LEN)
+	INX	H
+	INX	H	;FOR COLLISION FIELD
+	INX	H	;FOR TYPE/LEN FIELD
+	RET		;WITH H,L ADDRESSING VALUE FIELD
+;
+SETVAL:	;SET THE VALUE FIELD OF THE CURRENT SYMBOL
+;	VALUE IS SENT IN H,L
+	PUSH	H	;SAVE VALUE TO SET
+	CALL	VALADR
+	POP	D	;POP VALUE TO SET, HL HAS ADDRESS TO FILL
+	MOV	M,E
+	INX	H
+	MOV	M,D	;FIELD SET
+	RET
+;
+GETVAL:	;GET THE VALUE FIELD OF THE CURRENT SYMBOL TO H,L
+	CALL	VALADR	;ADDRESS OF VALUE FIELD TO H,L
+	MOV	E,M
+	INX	H
+	MOV	D,M
+	XCHG
+	RET
+;
+ENDMOD	EQU	($ AND 0FFE0H) + 20H
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as4sear.asm

@@ -0,0 +1,418 @@
+	TITLE	'ASM TABLE SEARCH MODULE'
+	org	0
+base	equ	$
+
+	ORG	15A0H
+	JMP	ENDMOD	;TO NEXT MODULE
+	JMP	BSEAR
+	JMP	BGET
+;
+;	COMMON EQUATES
+PBMAX	EQU	90	;MAX PRINT SIZE
+PBUFF	EQU	base+10CH	;PRINT BUFFER
+PBP	EQU	PBUFF+PBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	PBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR NEXT HEX BYTE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+;
+;	GLOBAL EQUATES
+IDEN	EQU	1	;IDENTIFIER
+NUMB	EQU	2	;NUMBER
+STRNG	EQU	3	;STRING
+SPECL	EQU	4	;SPECIAL CHARACTER
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL
+;
+;
+CR	EQU	0DH	;CARRIAGE RETURN
+;
+;
+;	TABLE DEFINITIONS
+;
+;	TYPES
+XBASE	EQU	0	;START OF OPERATORS
+;	O1 THROUGH O15 DENOTE OPERATIONS
+RT	EQU	16
+PT	EQU	RT+1	;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
+OBASE	EQU	PT+1
+O1	EQU	OBASE+1	;SIMPLE
+O2	EQU	OBASE+2	;LXI
+O3	EQU	OBASE+3	;DAD
+O4	EQU	OBASE+4	;PUSH/POP
+O5	EQU	OBASE+5	;JMP/CALL
+O6	EQU	OBASE+6	;MOV
+O7	EQU	OBASE+7	;MVI
+O8	EQU	OBASE+8	;ACC IMMEDIATE
+O9	EQU	OBASE+9	;LDAX/STAX
+O10	EQU	OBASE+10	;LHLD/SHLD/LDA/STA
+O11	EQU	OBASE+11	;ACCUM REGISTER
+O12	EQU	OBASE+12	;INC/DEC
+O13	EQU	OBASE+13	;INX/DCX
+O14	EQU	OBASE+14	;RST
+O15	EQU	OBASE+15	;IN/OUT
+;
+;	X1 THROUGH X15 DENOTE OPERATORS
+X1	EQU	XBASE	;*
+X2	EQU	XBASE+1	;/
+X3	EQU	XBASE+2	;MOD
+X4	EQU	XBASE+3	;SHL
+X5	EQU	XBASE+4	;SHR
+X6	EQU	XBASE+5	;+
+X7	EQU	XBASE+6	;-
+X8	EQU	XBASE+7	;UNARY -
+X9	EQU	XBASE+8	;NOT
+X10	EQU	XBASE+9	;AND
+X11	EQU	XBASE+10;OR
+X12	EQU	XBASE+11;XOR
+X13	EQU	XBASE+12;(
+X14	EQU	XBASE+13;)
+X15	EQU	XBASE+14;,
+X16	EQU	XBASE+15;CR
+;
+;
+;
+;
+;	RESERVED WORD TABLES
+;
+;	BASE ADDRESS VECTOR FOR CHARACTERS
+CINX:	DW	CHAR1	;LENGTH 1 BASE
+	DW	CHAR2	;LENGTH 2 BASE
+	DW	CHAR3	;LENGTH 3 BASE
+	DW	CHAR4	;LENGTH 4 BASE
+	DW	CHAR5	;LENGTH 5 BASE
+	DW	CHAR6	;LENGTH 6 BASE
+;
+CMAX	EQU	($-CINX)/2-1	;LARGEST STRING TO MATCH
+;
+CLEN:	;LENGTH VECTOR GIVES THE NUMBER OF ITEMS IN EACH TABLE
+	DB	CHAR2-CHAR1
+	DB	(CHAR3-CHAR2)/2
+	DB	(CHAR4-CHAR3)/3
+	DB	(CHAR5-CHAR4)/4
+	DB	(CHAR6-CHAR5)/5
+;
+TVINX:	;TABLE OF TYPE,VALUE PAIRS FOR EACH RESERVED SYMBOL
+	DW	TV1
+	DW	TV2
+	DW	TV3
+	DW	TV4
+	DW	TV5
+;
+;	CHARACTER VECTORS FOR 1,2,3,4, AND 5 CHARACTER NAMES
+CHAR1:	DB	CR,'()*'
+	DB	'+'
+	DB	',-/A'
+	DB	'BCDE'
+	DB	'HLM'
+;
+CHAR2:	DB	'DBDIDSDW'
+	DB	'EIIFINOR'
+	DB	'SP'
+;
+CHAR3:	DB	'ACIADCADDADI'
+	DB	'ANAANDANICMA'
+	DB	'CMCCMPCPIDAA'
+	DB	'DADDCRDCXEND'
+	DB	'EQUHLTINRINX'
+	DB	'JMPLDALXIMOD'
+	DB	'MOVMVINOPNOT'
+	DB	'ORAORGORIOUT'
+	DB	'POPPSWRALRAR'
+	DB	'RETRLCRRCRST'
+	DB	'SBBSBISETSHL'
+	DB	'SHRSTASTCSUB'
+	DB	'SUIXORXRAXRI'
+;
+CHAR4:	DB	'CALLENDMLDAXLHLDPCHL'
+	DB	'PUSHSHLDSPHLSTAX'
+	DB	'XCHGXTHL'
+;
+CHAR5:	DB	'ENDIFMACROTITLE'
+;
+CHAR6:	;END OF CHARACTER VECTOR
+;
+TV1:	;TYPE,VALUE PAIRS FOR CHAR1 VECTOR
+	DB	X16,10,		X13,20		;CR (
+	DB	X14,30,		X1,80		;) *
+	DB	X6,70				;+
+	DB	X15,10,		X7,70		;, -
+	DB	X2,80,		RT,7		;/ A
+	DB	RT,0,		RT,1		;B C
+	DB	RT,2,		RT,3		;D E
+	DB	RT,4,		RT,5		;H L
+	DB	RT,6				;M
+;
+TV2:	;TYPE,VALUE PAIRS FOR CHAR2 VECTOR
+	DB	PT,1,		O1,0F3H		;DB DI
+	DB	PT,2,		PT,3		;DS DW
+	DB	O1,0FBH,	PT,8		;EI IF
+	DB	O15,0DBH,	X11,40		;IN OR
+	DB	RT,6				;SP
+;
+;
+TV3:	;TYPE,VALUE PAIRS FOR CHAR3 VECTOR
+	DB	O8,0CEH,	O11,88H		;ACI ADC
+	DB	O11,80H,	O8,0C6H		;ADD ADI
+	DB	O11,0A0H,	X10,50		;ANA AND
+	DB	O8,0E6H,	O1,2FH		;ANI CMA
+	DB	O1,3FH,		O11,0B8H	;CMC CMP
+	DB	O8,0FEH,	O1,27H		;CPI DAA
+	DB	O3,09H,		O12,05H		;DAD DCR
+	DB	O13,0BH,	PT,4		;DCX END
+	DB	PT,7,		O1,76H		;EQU HLT
+	DB	O12,04H,	O13,03H		;INR INX
+	DB	O5,0C3H,	O10,3AH		;JMP LDA
+	DB	O2,01H,		X3,80		;LXI MOD
+	DB	O6,40H,		O7,06H		;MOV MVI
+	DB	O1,00H,		X9,60		;NOP NOT
+	DB	O11,0B0H,	PT,10		;ORA ORG
+	DB	O8,0F6H,	O15,0D3H	;ORI OUT
+	DB	O4,0C1H,	RT,6		;POP PSW
+	DB	O1,17H,		O1,1FH		;RAL RAR
+	DB	O1,0C9H,	O1,07H		;RET RLC
+	DB	O1,0FH,		O14,0C7H	;RRC RST
+	DB	O11,098H,	O8,0DEH		;SBB SBI
+	DB	PT,11,		X4,80		;SET SHL
+	DB	X5,80,		O10,32H		;STA STC
+	DB	O1,37H,		O11,90H		;STC SUB
+	DB	O8,0D6H,	X12,40		;SUI XOR
+	DB	O11,0A8H,	O8,0EEH		;XRA XRI
+;
+;
+TV4:	;TYPE,VALUE PAIRS FOR CHAR4 VECTOR
+	DB	O5,0CDH				;CALL
+	DB	PT,6,		O9,0AH		;ENDM LDAX
+	DB	O10,02AH,	O1,0E9H		;LHLD PCHL
+	DB	O4,0C5H,	O10,22H		;PUSH SHLD
+	DB	O1,0F9H,	O9,02H		;SPHL STAX
+	DB	O1,0EBH,	O1,0E3H		;XCHG XTHL
+;
+TV5:	;TYPE,VALUE PAIRS FOR CHAR5 VECTOR
+	DB	PT,5,		PT,9		;ENDIF MACRO
+	DB	PT,12				;TITLE
+;
+SUFTAB:	;TABLE OF SUFFIXES FOR J C AND R OPERATIONS
+	DB	'NZZ NCC POPEP M '
+;
+BSEAR:	;BINARY SEARCH MNEMONIC TABLE
+;	INPUT: UR = UPPER BOUND OF TABLE (I.E., TABLE LENGTH-1)
+;		SR = SIZE OF EACH TABLE ELEMENT
+;		H,L ADDRESS BASE OF TABLE TO SEARCH
+;	OUTPUT: ZERO FLAG INDICATES MATCH WAS FOUND, IN WHICH CASE
+;		THE ACCUMULATOR CONTAINS AN INDEX TO THE ELEMENT
+;		NOT ZERO FLAG INDICATES NO MATCH FOUND IN TABLE
+;
+UR	EQU	B	;UPPER BOUND REGISTER
+LR	EQU	C	;LOWER BOUND REGISTER
+SR	EQU	D	;SIZE REGISTER
+MR	EQU	E	;MIDDLE POINTER REGISTER
+SP1	EQU	B	;SIZE PRIME, USED IN COMPUTING MIDDLE POSITON
+SP1P	EQU	C	;ANOTHER COPY OF SIZE PRIME
+KR	EQU	H	;K
+;
+	MVI	MR,255	;MARK M <> OLD M
+	INR	UR	;U=U+1
+	MVI	LR,0	;L = 0
+;
+;	COMPUTE M' = (U+L)/2
+NEXT:	XRA	A
+	MOV	A,UR	;CY=0, A=U
+	ADD	LR	;(U+L)
+	RAR	;(U+L)/2
+	CMP	MR	;SAME AS LAST TIME THROUGH?
+	JZ	NMATCH	;JUMP IF = TO NO MATCH
+;
+;	MORE ELEMENTS TO SCAN
+	MOV	MR,A	;NEW MIDDLE VALUE
+	PUSH	H	;SAVE A COPY OF THE BASE ADDRESS
+	PUSH	D	;SAVE S,M
+	PUSH	B	;SAVE U,L
+	PUSH	H	;SAVE ANOTHER COPY OF THE BASE ADDRESS
+	MOV	SP1,SR	;S' = S
+	MOV	SP1P,SP1	;S'' = S'
+	MVI	SR,0	;FOR DOUBLE ADD OPERATION BELOW (DOUBLE M)
+;
+	LXI	KR,0	;K=0
+SUMK:	DAD	D	;K = K + M
+	DCR	SP1	;S' = S' - 1
+	JNZ	SUMK	;DECREMENT IF SP1 <> 0
+;
+;	K IS NOW RELATIVE BYTE POSITION
+	POP	D	;TABLE BASE ADDRESS
+	DAD	D	;H,L CONTAINS ABSOLUTE ADDRESS OF BYTE TO COMPARE
+	LXI	D,ACCUM	;D,E ADDRESS CHARACTERS TO COMPARE
+;
+COMK:	;COMPARE NEXT CHARACTER
+	LDAX	D	;ACCUM CHARACTER TO REG A
+	CMP	M	;SAME AS TABLE ENTRY?
+	INX	D
+	INX	H	;TO NEXT POSITIONS
+	JNZ	NCOM	;JUMP IF NOT THE SAME
+	DCR	SP1P	;MORE CHARACTERS?
+	JNZ	COMK
+;
+;	COMPLETE MATCH AT M
+	POP	B
+	POP	D	;M RESTORED
+	POP	H
+	MOV	A,MR	;VALUE OF M COPIED IN A
+	RET		;WITH ZERO FLAG SET
+;
+NCOM:	;NO MATCH, DETERMINE IF LESS OR GREATER
+	POP	B	;U,L
+	POP	D	;S,M
+	POP	H	;TABLE ADDRESS
+	JC	NCOML
+;	ACCUM IS HIGHER
+	MOV	LR,MR	;L = M
+	JMP	NEXT
+;
+NCOML:	;ACCUMULATOR IS LOW
+	MOV	UR,MR	;U = M
+	JMP	NEXT
+;
+NMATCH:	;NO MATCH
+	XRA	A
+	INR	A	;SETS NOT ZERO FLAG
+	RET
+;
+PREFIX:	;J C OR R PREFIX?
+	LDA	ACCUM
+	LXI	B,(0C2H SHL 8) OR O5	;JNZ OPCODE TO B, TYPE TO C
+	CPI	'J'
+	RZ		;RETURN WITH ZERO FLAG SET IF J
+	MVI	B,0C4H		;CNZ OPCODE TO B, TYPE IS IN C
+	CPI	'C'
+	RZ
+	LXI	B,(0C0H SHL 8) OR O1	;RNZ OPCODE
+	CPI	'R'
+	RET
+;
+SUFFIX:	;J R OR C RECOGNIZED, LOOK FOR SUFFIX
+	LDA	ACCLEN
+	CPI	4	;CHECK LENGTH
+	JNC	NSUFF	;CARRY IF 0,1,2,3 IN LENGTH
+	CPI	3
+	JZ	SUF0	;ASSUME 1 OR 2 IF NO BRANCH
+	CPI	2
+	JNZ	NSUFF	;RETURNS IF 0 OR 1
+	LXI	H,ACCUM+2
+	MVI	M,' '	;BLANK-OUT FOR MATCH ATTEMPT
+SUF0:	;SEARCH 'TIL END OF TABLE
+	LXI	B,8	;B=0, C=8 COUNTS TABLE DOWN TO ZERO OR MATCH
+	LXI	D,SUFTAB
+NEXTS:	;LOOK AT NEXT SUFFIX
+	LXI	H,ACCUM+1	;SUFFIX POSITION
+	LDAX	D		;CHARACTER TO ACCUM
+	CMP	M
+	INX	D		;READY FOR NEXT CHARACTER
+	JNZ	NEXT0		;JMP IF NO MATCH
+	LDAX	D		;GET NEXT CHARACTER
+	INX	H		;READY FOR COMPARE WITH ACCUM
+	CMP	M		;SAME?
+	RZ			;RETURN WITH ZERO FLAG SET, B IS SUFIX
+NEXT0:	INX	D		;MOVE TO NEXT CHARACTER
+	INR	B		;COUNT SUFFIX UP
+	DCR	C		;COUNT TABLE LENGTH DOWN
+	JNZ	NEXTS
+;	END OF TABLE, MARK WITH NON ZERO FLAG
+	INR	C
+	RET
+;
+NSUFF:	;NOT PROPER SUFFIX - SET NON ZERO FLAG
+	XRA	A
+	INR	A
+	RET
+;
+BGET:	;PERFORM BINARY SEARCH, AND EXTRACT TYPE AND VAL FIELDS FOR
+;	THE ITEM.  ZERO FLAG INDICATES MATCH WAS FOUND, WITH TYPE
+;	IN THE ACCUMULATOR, AND VAL IN REGISTER B.  THE SEARCH IS BASED
+;	UPON THE LENGTH OF THE ACCUMULATOR
+	LDA	ACCLEN	;ITEM LENGTH
+	MOV	C,A	;SAVE A COPY
+	DCR	A	;ACCLEN-1
+	MOV	E,A
+	MVI	D,0	;DOUBLE ACCLEN-1 TO D,E
+	PUSH	D	;SAVE A COPY FOR LATER
+	CPI	CMAX	;TOO LONG?
+	JNC	NGET	;NOT IN RANGE IF CARRY
+	LXI	H,CLEN	;LENGTH VECTOR
+	DAD	D
+	MOV	UR,M	;FILL UPPER BOUND FROM MEMORY
+	LXI	H,CINX
+	DAD	D
+	DAD	D	;BASE ADDRESS TO H,L
+	MOV	D,M
+	INX	H
+	MOV	H,M
+	MOV	L,D	;NOW IN H,L
+	MOV	SR,C	;FILL THE SIZE REGISTER
+	CALL	BSEAR	;PERFORM THE BINARY SEARCH
+	JNZ	SCASE	;ZERO IF FOUND
+	POP	D	;RESTORE INDEX
+	LXI	H,TVINX
+	DAD	D
+	DAD	D	;ADDRESSING PROPER TV ELEMENT
+	MOV	E,M
+	INX	H
+	MOV	D,M
+;	D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
+	MOV	L,A
+	MVI	H,0
+	DAD	H	;DOUBLED
+	DAD	D	;INDEXED
+	MOV	A,M	;TYPE TO ACC
+	INX	H
+	MOV	B,M	;VALUE TO B
+	RET		;TYPE IN ACC, VALUE IN B
+;
+SCASE:	;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
+	POP	D	;RESTORE INDEX
+	CALL	PREFIX
+	RNZ		;NOT FOUND AS PREFIX J C OR R IF NOT ZERO FLAG
+	PUSH	B	;SAVE VALUE AND TYPE
+	CALL	SUFFIX	;ZERO IF SUFFIX MATCHED
+	MOV	A,B	;READY FOR MASK IF ZERO FLAG
+	POP	B	;RECALL VALUE AND TYPE
+	RNZ		;RETURN IF NOT ZERO FLAG SET
+;	MASK IN THE PROPER BITS AND RETURN
+	ORA	A	;CLEAR CARRY
+	RAL
+	RAL
+	RAL
+	ORA	B	;VALUE SET TO JNZ ...
+	MOV	B,A	;REPLACE
+	MOV	A,C	;RETURN WITH TYPE IN REGISTER A
+	CMP	A	;CLEAR THE ZERO FLAG
+	RET
+;
+NGET:	;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
+	POP	D	;GET THE ELEMENT BACK
+	XRA	A	;CLEAR
+	INR	A	;ZERO FLAG RESET
+	RET
+;
+;
+ENDMOD	EQU	($ AND 0FFE0H) + 20H	;NEXT MODULE ADDRESS
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as5oper.asm

@@ -0,0 +1,597 @@
+	TITLE	'ASM OPERAND SCAN MODULE'
+;	OPERAND SCAN MODULE
+	org	0
+base	equ	$
+
+	ORG	1860H
+;
+;	EXTERNALS
+IOMOD	EQU	base+200H	;I/O MODULE
+SCMOD	EQU	base+1100H	;SCANNER MODULE
+SYMOD	EQU	base+1340H	;SYMBOL TABLE MODULE
+BMOD	EQU	base+15A0H	;BINARY SEARCH MODULE
+;
+;
+PERR	EQU	IOMOD+18H
+SCAN	EQU	SCMOD+6H	;SCANNER ENTRY POINT
+CR	EQU	0DH	;CARRIAGE RETURN
+;
+LOOKUP	EQU	SYMOD+6H	;LOOKUP
+FOUND	EQU	LOOKUP+3	;FOUND SYMBOL IF ZERO FLAG NOT SET
+ENTER	EQU	FOUND+3		;ENTER SYMBOL
+SETTY	EQU	ENTER+3		;SET TYPE FIELD
+GETTY	EQU	SETTY+3		;SET TYPE FIELD
+SETVAL	EQU	GETTY+3		;SET VALUE FIELD
+GETVAL	EQU	SETVAL+3	;GET VALUE FIELD
+;
+BSEAR	EQU	BMOD+3	;BINARY SEARCH ROUTINE
+BGET	EQU	BSEAR+3	;GET VALUES WITH SEARCH
+;
+;	COMMON EQUATES
+PBMAX	EQU	90	;MAX PRINT SIZE
+PBUFF	EQU	base+10CH	;PRINT BUFFER
+PBP	EQU	PBUFF+PBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	PBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR NEXT HEX BYTE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+;
+;	GLOBAL EQUATES
+IDEN	EQU	1	;IDENTIFIER
+NUMB	EQU	2	;NUMBER
+STRNG	EQU	3	;STRING
+SPECL	EQU	4	;SPECIAL CHARACTER
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL
+;
+;
+;	TABLE DEFINITIONS
+XBASE	EQU	0	;START OF OPERATORS
+OPER	EQU	15	;LAST OPERATOR
+RT	EQU	16
+PT	EQU	RT+1	;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
+OBASE	EQU	PT+1
+;
+PLUS	EQU	5
+MINUS	EQU	6
+NOTF	EQU	8	;NOT
+LPAR	EQU	12
+RPAR	EQU	13
+OSMAX	EQU	10
+VSMAX	EQU	8*2
+;
+;
+;	BEGINNING OF MODULE
+	JMP	ENDMOD	;PAST THIS MODULE
+	JMP	OPAND	;SCAN OPERAND FIELD
+	JMP	MULF	;MULTIPLY FUNCTION
+	JMP	DIVE	;DIVIDE FUNCTION
+UNARY:	DS	1	;TRUE IF NEXT OPERATOR IS UNARY
+OPERV:	DS	OSMAX	;OPERATOR STACK
+HIERV:	DS	OSMAX	;OPERATOR PRIORITY
+VSTACK:	DS	VSMAX	;VALUE STACK
+OSP:	DS	1	;OPERATOR STACK POINTER
+VSP:	DS	1	;VALUE STACK POINTER
+;
+;
+;
+STKV:	;PLACE CURRENT H,L VALUE AT TOP OF VSTACK
+	XCHG	;HOLD VALUE IN D,E
+	LXI	H,VSP
+	MOV	A,M
+	CPI	VSMAX
+	JC	STKV0
+	CALL	ERREX	;OVERFLOW IN EXPRESSION
+	MVI	M,0	;VSP=0
+STKV0:	MOV	A,M	;GET VSP
+	INR	M	;VSP=VSP+1
+	INR	M	;VSP=VSP+2
+	MOV	C,A	;SAVE VSP
+	MVI	B,0	;DOUBLE VSP
+	LXI	H,VSTACK
+	DAD	B
+	MOV	M,E	;LOW BYTE
+	INX	H
+	MOV	M,D	;HIGH BYTE
+	RET
+;
+STKO:	;STACK OPERATOR (REG-A) AND PRIORITY (REG-B)
+	PUSH	PSW	;SAVE IT
+	LXI	H,OSP
+	MOV	A,M
+	CPI	OSMAX
+	JC	STKO1
+	MVI	M,0
+	CALL	ERREX	;OPERATOR STACK OVERFLOW
+STKO1:	MOV	E,M	;GET OSP
+	MVI	D,0
+	INR	M	;OSP=OSP+1
+	POP	PSW	;RECALL OPERATOR
+	LXI	H,OPERV
+	DAD	D	;OPERV(OSP)
+	MOV	M,A	;OPERV(OSP)=OPERATOR
+	LXI	H,HIERV
+	DAD	D
+	MOV	M,B	;HIERV(OSP)=PRIORITY
+	RET
+;
+LODV1:	;LOAD TOP ELEMENT FROM VSTACK TO H,L
+	LXI	H,VSP
+	MOV	A,M
+	ORA	A
+	JNZ	LODOK
+	CALL	ERREX	;UNDERFLOW
+	LXI	H,0
+	RET
+;
+LODOK:	DCR	M
+	DCR	M	;VSP=VSP-2
+	MOV	C,M	;LOW BYTE
+	MVI	B,0
+	LXI	H,VSTACK
+	DAD	B	;VSTACK(VSP)
+	MOV	C,M	;GET LOW BYTE
+	INX	H
+	MOV	H,M
+	MOV	L,C
+	RET
+;
+LODV2:	;LOAD TOP TWO ELEMENTS DE HOLDS TOP, HL HOLDS TOP-1
+	CALL	LODV1
+	XCHG
+	CALL	LODV1
+	RET
+;
+APPLY:	;APPLY OPERATOR IN REG-A TO TOP OF STACK
+	MOV	L,A
+	MVI	H,0
+	DAD	H	;OPERATOR NUMBER*2
+	LXI	D,OPTAB
+	DAD	D	;INDEXED OPTAB
+	MOV	E,M	;LOW ADDRESS
+	INX	H
+	MOV	H,M	;HIGH ADDRESS
+	MOV	L,E
+	PCHL		;SET PC AND GO TO SUBROUTINE
+;
+OPTAB:	DW	MULOP
+	DW	DIVOP
+	DW	MODOP
+	DW	SHLOP
+	DW	SHROP
+	DW	ADDOP
+	DW	SUBOP
+	DW	NEGOP
+	DW	NOTOP
+	DW	ANDOP
+	DW	OROP
+	DW	XOROP
+	DW	ERREX	;(
+;
+;	SPECIFIC HANDLERS FOLLOW
+SHFT:	;SET UP OPERANDS FOR SHIFT L AND R
+	CALL	LODV2
+	MOV	A,D	;ENSURE 0-15
+	ORA	A
+	JNZ	SHERR
+	MOV	A,E
+	CPI	17
+	RC		;RETURN IF 0-16 SHIFT
+SHERR:	CALL	ERREX
+	MVI	A,16
+	RET
+;
+NEGF:	;COMPUTE 0-H,L TO H,L
+	XRA	A
+	SUB	L
+	MOV	L,A
+	MVI	A,0
+	SBB	H
+	MOV	H,A
+	RET
+;
+DIVF:	CALL	LODV2
+DIVE:	;(EXTERNAL ENTRY FROM MAIN PROGRAM)
+	XCHG		;SWAP D,E WITH H,L FOR DIVIDE FUNCTION
+;	COMPUTE X/Y WHERE X IS IN D,E AND Y IS IN H,L
+;	THE VALUE OF X/Y APPEARS IN D,E AND X MOD Y IS IN H,L
+;
+	SHLD	DTEMP	;SAVE X IN TEMPORARY
+	LXI	H,BNUM	;STORE BIT COUNT
+	MVI	M,11H
+	LXI	B,0	;INTIALIZE RESULT
+	PUSH	B
+	XRA	A	;CLEAR FLAGS
+DLOOP:
+	MOV	A,E	;GET LOW Y BYTE
+	RAL
+	MOV	E,A
+	MOV	A,D
+	RAL
+	MOV	D,A
+	DCR	M	;DECREMENT BIT COUNT
+	POP	H	;RESTORE TEMP RESULT
+	RZ		;ZERO BIT COUNT MEANS ALL DONE
+	MVI	A,0	;ADD IN CARRY
+	ACI	0	;CARRY
+	DAD	H	;SHIFT TEMP RESULT LEFT ONE BIT
+	MOV	B,H	;COPY HA AND L TO A A ND C
+	ADD	L
+	LHLD	DTEMP	;GET ADDRESS OF X
+	SUB	L	;SUBTRACT FROM TEMPORARY RESULT
+	MOV	C,A
+	MOV	A,B
+	SBB	H
+	MOV	B,A
+	PUSH	B	;SAVE TEMP RESULT IN STACK
+	JNC	DSKIP	;NO BORROW FROM SUBTRACT
+	DAD	B	;ADD X BACK IN
+	XTHL	;REPLACE TEMP RESULT ON STACK
+DSKIP:	LXI	H,BNUM	;RESTORE H,L
+	CMC
+	JMP	DLOOP	;REPEAT LOOP STEPS
+;
+DTEMP:	DS	2
+BNUM:	DS	1
+;
+MULF:	;MULTIPLY D,E BY H,L AND REPLACE H,L WITH RESULT
+	MOV	B,H
+	MOV	C,L	;COPY OF 1ST VALUE TO B,C FOR SHIFT AND ADD
+	LXI	H,0	;H,L IS THE ACCUMULATOR
+MUL0:	XRA	A
+	MOV	A,B	;CARRY IS CLEARED
+	RAR
+	MOV	B,A
+	MOV	A,C
+	RAR
+	MOV	C,A
+	JC	MUL1	;SKIP THIS ADD IF LSB IS ZERO
+	ORA	B
+	RZ		;RETURN WITH H,L
+	JMP	MUL2	;SKIP ADD
+MUL1:	DAD	D	;ADD CURRENT VALUE OF D
+MUL2:	XCHG	;READY FOR *2
+	DAD	H
+	XCHG
+	JMP	MUL0
+;
+MULOP:	;MULTIPLY D,E BY H,L
+	CALL	LODV2
+	CALL	MULF
+	JMP	ENDOP
+;
+DIVOP:	;DIVIDE H,L BY D,E
+	CALL	DIVF
+	XCHG		;RESULT TO H,L
+	JMP	ENDOP
+;
+MODOP:	CALL	DIVF
+	JMP	ENDOP
+;
+SHLOP:	CALL	SHFT	;CHECK VALUES
+SHL0:	ORA	A	;DONE?
+	JZ	ENDOP
+	DAD	H	;HL=HL*2
+	DCR	A
+	JMP	SHL0
+;
+SHROP:	CALL	SHFT
+SHR0:	ORA	A	;DONE?
+	JZ	ENDOP
+	PUSH	PSW	;SAVE CURRENT COUNT
+	XRA	A
+	MOV	A,H
+	RAR
+	MOV	H,A
+	MOV	A,L
+	RAR
+	MOV	L,A
+	POP	PSW
+	DCR	A
+	JMP	SHR0
+;
+ADDOP:	CALL	LODV2
+ADD0:	DAD	D
+	JMP	ENDOP
+;
+SUBOP:	CALL	LODV2
+	XCHG		;TREAT AS HL+(-DE)
+	CALL	NEGF	;0-HL
+	JMP	ADD0
+;
+NEGOP:	CALL	LODV1
+NEG0:	CALL	NEGF	;COMPUTE 0-HL
+	JMP	ENDOP
+;
+NOTOP:	CALL	LODV1
+	INX	H	;65536-HL = 65535-(HL+1)
+	JMP	NEG0
+;
+ANDOP:	CALL	LODV2
+	MOV	A,D
+	ANA	H
+	MOV	H,A
+	MOV	A,E
+	ANA	L
+	MOV	L,A
+	JMP	ENDOP
+;
+OROP:	CALL	LODV2
+	MOV	A,D
+	ORA	H
+	MOV	H,A
+	MOV	A,E
+	ORA	L
+	MOV	L,A
+	JMP	ENDOP
+;
+XOROP:	CALL	LODV2
+	MOV	A,D
+	XRA	H
+	MOV	H,A
+	MOV	A,E
+	XRA	L
+	MOV	L,A
+;
+ENDOP:	JMP	STKV
+;
+;
+;
+ENDEXP:	;RETURNS ZERO FLAG IF SYMBOL IS CR, ;, OR ,
+	LDA	TOKEN
+	CPI	SPECL
+	RNZ		;NOT END IF NOT SPECIAL
+;
+	LDA	ACCUM
+	CPI	CR
+	RZ
+	CPI	';'
+	RZ
+	CPI	','
+	RZ
+	CPI	'!'
+	RET
+;
+OPAND:	;SCAN THE OPERAND FIELD OF AN INSTRUCTION
+;	(NOT A DB WITH FIRST TOKEN STRING > 2 OR 0)
+	XRA	A
+	STA	OSP	;ZERO OPERATOR STACK POINTER
+	STA	VSP
+	DCR	A	;255
+	STA	UNARY
+	LXI	H,0
+	SHLD	EVALUE
+;
+OP0:	;ARRIVE HERE WITH NEXT ITEM ALREADY SCANNED
+	CALL	ENDEXP	;DONE?
+	JNZ	OP1
+;	EMPTY THE OPERATOR STACK
+EMPOP:	LXI	H,OSP
+	MOV	A,M	;GET THE OSP AND CHECK FOR EMPTY
+	ORA	A
+	JZ	CHKVAL	;JUMP IF EMPTY
+	DCR	M	;POP ELEMENT
+	MOV	E,A	;COPY FOR DOUBLE ADD
+	DCR	E
+	MVI	D,0
+	LXI	H,OPERV
+	DAD	D	;INDEXED - OPERV(OSP)
+	MOV	A,M	;GET OPERATOR
+	CALL	APPLY	;APPLY OPERATOR
+	JMP	EMPOP
+;
+CHKVAL:
+	LDA	VSP	;MUST HAVE ONE ELEMENT IT THE STACK
+	CPI	2
+	CNZ	ERREX
+	LDA	PBUFF
+	CPI	' '
+	RNZ		;EVALUE REMAINS AT ZERO
+	LHLD	VSTACK	;GET DOUBLE BYTE IN STACK
+	SHLD	EVALUE
+	RET
+;
+OP1:	;MORE TO SCAN
+	LDA	PBUFF
+	CPI	' '
+	JNZ	GETOP
+	LDA	TOKEN
+	CPI	STRNG	;IS THIS A STRING?
+	JNZ	OP3
+;
+;	STRING - CONVERT TO DOUBLE PRECISION
+	LDA	ACCLEN
+	ORA	A
+	CZ	ERREX	;ERROR IF LENGTH=0
+	CPI	3
+	CNC	ERREX	;ERROR IF LENGTH>2
+	MVI	D,0
+	LXI	H,ACCUM
+	MOV	E,M	;LSBYTE
+	INX	H
+	DCR	A	;A HAS THE LENGTH
+	JZ	OP2	;ONE OR TWO BYTES
+	MOV	D,M	;FILL HIGH ORDER
+OP2:	XCHG		;VALUE TO H,L
+	JMP	STNUM	;STORE TO STACK
+;
+OP3:	;NOT A STRING, CHECK FOR NUMBER
+	CPI	NUMB
+	JNZ	OP4
+	LHLD	VALUE	;NUMERIC VALUE
+	JMP	STNUM
+;
+OP4:	;NOT STRING OR NUMBER, MUST BE ID OR SPECL
+	CALL	BGET	;BINARY SEARCH, GET ATTRIBUTES
+	JNZ	OP6	;MATCH?
+;	YES, MAY BE OPERATOR
+	CPI	OPER+1
+	JNC	OP5
+;	OPERATOR ENCOUNTERED MS NIBBLE OF B IS PRIORITY NUMBER LS NIBBLE
+;	IS THE OPERATOR
+;	ACC HAS THE OPERATOR NUMBER, B HAS PRIORITY
+	CPI	LPAR	;(?
+	MOV	C,A	;SAVE COPY OF OPERATOR NUMBER
+	LDA	UNARY
+	JNZ	OPER1	;JUMP IF NOT A (
+;	( ENCOUNTERED, UNARY MUST BE TRUE
+	ORA	A
+	CZ	ERREX
+	MVI	A,0FFH
+	STA	UNARY	;UNARY IS SET TRUE
+	MOV	A,C	;RECOVER OPERATOR
+	JMP	OPER4	;CALLS STKO AND SETS UNARY TO TRUE
+;
+;
+OPER1:	;NOT A LEFT PAREN
+	ORA	A
+	JNZ	OPER6	;MUST BE + OR - SINCE UNARY IS SET
+;
+;	UNARY NOT SET, MUST BE BINARY OPERATOR
+OPER2:	;COMPARE HIERARCHY OF TOS
+	PUSH	B	;SAVE PRIORITY AND OPERATOR NUMBER
+	LDA	OSP
+	ORA	A
+	JZ	OPER3	;NO MORE OPERATORS IN STACK
+	MOV	E,A	;OSP TO E
+	DCR	E	;OSP-1
+	MVI	D,0
+	LXI	H,HIERV
+	DAD	D	;HL ADDRESSES TOP OF OPERATOR STACK
+	MOV	A,M	;PRIORITY OF TOP OPERATOR
+	CMP	B	;CURRENT GREATER?
+	JC	OPER3	;JUMP IF SO
+;	APPLY TOP OPERATOR TO VALUE STACK
+	LXI	H,OSP
+	MOV	M,E	;OSP=OSP-1
+	LXI	H,OPERV
+	DAD	D
+	MOV	A,M	;OPERATOR NUMBER TO ACC
+	CALL	APPLY
+	POP	B	;RESTORE OPERATOR NUMBER AND PRIORITY
+	JMP	OPER2	;FOR ANOTHER TEST
+;
+OPER3:	;ARRIVE HERE WHEN OPERATOR IS STACKED
+;	CHECK FOR RIGHT PAREN BALANCE
+	POP	B	;OPERATOR NUMBER IN C, PRIORITY IN B
+	MOV	A,C
+	CPI	RPAR
+	JNZ	OPER4	;JUMP IF NOT A RIGHT PAREN
+;
+;	RIGHT PAREN FOUND, STACK MUST CONTAIN LEFT PAREN TO DELETE
+	LXI	H,OSP
+	MOV	A,M
+	ORA	A	;ZERO?
+	JZ	LPERR	;PAREN ERROR IF SO
+	DCR	A	;OSP-1
+	MOV	M,A	;STORED TO MEMORY
+	MOV	E,A
+	MVI	D,0
+	LXI	H,OPERV
+	DAD	D
+	MOV	A,M	;TOP OPERATOR IN REG-A
+	CPI	LPAR
+	JZ	NLERR	;JMP IF NO ERROR - PARENS BALANCE
+LPERR:	CALL	ERREX
+NLERR:	;ERROR REPORTING COMPLETE
+	XRA	A
+	JMP	OPER5	;TO CLEAR UNARY FLAG
+;
+OPER4:	;ORDINARY OPERATOR
+	CALL	STKO
+	MVI	A,0FFH	;TO SET UNARY FLAG
+OPER5:	STA	UNARY
+	JMP	GETOP	;FOR ANOTHER ELEMENT
+;
+OPER6:	;UNARY SET, MUST BE + OR -
+	MOV	A,C	;RECALL OPERATOR
+	CPI	PLUS
+	JZ	GETOP	;IGNORE UNARY PLUS
+	CPI	MINUS
+	JNZ	CHKNOT
+	INR	A	;CHANGE TO UNARY MINUS
+	MOV	C,A
+	JMP	OPER2
+CHKNOT:	;UNARY NOT SYMBOL?
+	CPI	NOTF
+	CNZ	ERREX
+	JMP	OPER2
+;
+;
+OP5:	;ELEMENT FOUND IN TABLE, NOT AN OPERATOR
+	CPI	PT	;PSEUDO OPERATOR?
+	CZ	ERREX	;ERROR IF SO
+	MOV	L,B	;GET LOW VALUE TO L
+	MVI	H,0	;ZERO HIGH ORDER BYTE
+	JMP	STNUM	;STORE IT
+;
+OP6:	;NOT FOUND IN TABLE SCAN, $?
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	OP7
+	LDA	ACCUM
+	CPI	'$'
+	JZ	CURPC	;USE CURRENT PC
+	CALL	ERREX
+	LXI	H,0
+	JMP	STNUM
+CURPC:	LHLD	ASPC	;GET CURRENT PC
+	JMP	STNUM
+;
+OP7:	;NOT $, LOOK IT UP
+	CALL	LOOKUP
+	CALL	FOUND
+	JNZ	FIDENT
+;	NOT FOUND IN SYMBOL TABLE, ENTER IF PASS 1
+	MVI	A,'P'
+	CALL	PERR
+	CALL	ENTER	;ENTER SYMBOL WITH ZERO TYPE FIELD
+	JMP	FIDE0
+FIDENT:	CALL	GETTY	;TYPE TO H,L
+	ANI	111B
+	MVI	A,'U'
+	CZ	PERR
+;
+FIDE0:
+	CALL	GETVAL	;VALUE TO H,L
+;
+STNUM:	;STORE H,L TO VALUE STACK
+	LDA	UNARY
+	ORA	A	;UNARY OPERATION SET
+	CZ	ERREX	;OPERAND ENCOUNTERED WITH UNARY OFF
+	XRA	A
+	STA	UNARY	;SET TO OFF
+	CALL	STKV	;STACK THE VALUE
+;
+GETOP:	CALL	SCAN
+	JMP	OP0
+;
+ERREX:	;PUT 'E' ERROR IN OUTPUT BUFFER
+	PUSH	H
+	MVI	A,'E'
+	CALL	PERR
+	POP	H
+	RET
+;
+ENDMOD	EQU	($ AND 0FFE0H) + 20H	;NEXT HALF PAGE
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/as6main.asm

@@ -0,0 +1,895 @@
+	TITLE	'ASM MAIN MODULE'
+;	MP/M RESIDENT ASSEMBLER MAIN PROGRAM
+;
+;		COPYRIGHT  (C) 1976, 1977, 1978, 1979, 1980, 1981
+;		DIGITAL RESEARCH
+;		BOX 579, PACIFIC GROVE
+;		CALIFORNIA, 93950
+;
+;		Revised:
+;		  14 Sept 81  by Thomas Rolander
+;
+;
+	org	0
+base	equ	$
+
+	ORG	1BA0H
+;	MODULE ENTRY POINTS
+IOMOD	EQU	base+200H	;IO MODULE
+SCMOD	EQU	base+1100H	;SCANNER MODULE
+SYMOD	EQU	base+1340H	;SYMBOL TABLE MODULE
+BMOD	EQU	base+15A0H	;BINARY SEARCH MODULE
+OPMOD	EQU	base+1860H	;OPERAND SCAN MODULE
+;
+SETUP	EQU	IOMOD+3H	;FILE SETUP FOR EACH PASS
+PCON	EQU	IOMOD+12H	;WRITE CONSOLE BUFFER TO CR
+WOBUFF	EQU	IOMOD+15H	;WRITE PRINT BUFFER AND REINITIALIZE
+PERR	EQU	IOMOD+18H	;WRITE ERROR CHARACTER TO PRINT BUFFER
+DHEX	EQU	IOMOD+1BH	;SEND HEX CHARACTER TO MACHINE CODE FILE
+EOR	EQU	IOMOD+1EH	;END OF PROCESSING, CLOSE FILES AND TERMINATE
+;
+INITS	EQU	SCMOD+3H	;INITIALIZE SCANNER MODULE
+SCAN	EQU	SCMOD+6H	;SCAN NEXT TOKEN
+;
+INISY	EQU	SYMOD+3H	;INITIALIZE SYMBOL TABLE
+LOOKUP	EQU	SYMOD+6H	;LOOKUP SYMBOL IN ACCUMULATOR
+FOUND	EQU	SYMOD+9H	;FOUND IF NZ FLAG
+ENTER	EQU	SYMOD+0CH	;ENTER SYMBOL IN ACCUMULATOR
+SETTY	EQU	SYMOD+0FH	;SET TYPE FIELD
+GETTY	EQU	SYMOD+12H	;GET TYPE FIELD
+SETVAL	EQU	SYMOD+15H	;SET VALUE FIELD
+GETVAL	EQU	SYMOD+18H	;GET VALUE FIELD
+;
+BGET	EQU	BMOD+6H		;BINARY SEARCH AND GET TYPE/VALUE PAIR
+;
+OPAND	EQU	OPMOD+3H	;GET OPERAND VALUE TO 'EVALUE'
+MULF	EQU	OPMOD+6H	;MULT D,E BY H,L TO H,L
+DIVF	EQU	OPMOD+9H	;DIVIDE HL BY DE, RESULT TO DE
+;
+;
+;	COMMON EQUATES
+PBMAX	EQU	90	;MAX PRINT SIZE
+PBUFF	EQU	base+10CH	;PRINT BUFFER
+PBP	EQU	PBUFF+PBMAX	;PRINT BUFFER POINTER
+;
+TOKEN	EQU	PBP+1	;CURRENT TOKEN UDER SCAN
+VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
+ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
+ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
+ACCUM	EQU	ACCLEN+1
+;
+EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
+;
+SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
+SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
+;
+PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
+FPC	EQU	PASS+1	;FILL ADDRESS FOR NEXT HEX BYTE
+ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
+SYBAS	EQU	ASPC+2	;BASE OF SYMBOL TABLE
+SYADR	EQU	SYBAS+2	;CURRENT SYMBOL ADDRESS
+;
+;	GLOBAL EQUATES
+IDEN	EQU	1	;IDENTIFIER
+NUMB	EQU	2	;NUMBER
+STRNG	EQU	3	;STRING
+SPECL	EQU	4	;SPECIAL CHARACTER
+;
+PLABT	EQU	0001B	;PROGRAM LABEL
+DLABT	EQU	0010B	;DATA LABEL
+EQUT	EQU	0100B	;EQUATE
+SETT	EQU	0101B	;SET
+MACT	EQU	0110B	;MACRO
+;
+EXTT	EQU	1000B	;EXTERNAL
+REFT	EQU	1011B	;REFER
+GLBT	EQU	1100B	;GLOBAL
+;
+CR	EQU	0DH	;CARRIAGE RETURN
+LF	EQU	0AH	;LINE FEED
+EOF	EQU	1AH	;END OF FILE
+NBMAX	EQU	16	;STARTING POSITION OF PRINT LINE
+;
+;
+RT	EQU	16	;REGISTER TYPE
+PT	EQU	RT+1	;PSEUDO OPERATION
+PENDIF	EQU	5	;PSEUDO OPERATOR 'ENDIF'
+OBASE	EQU	PT+1
+O1	EQU	OBASE+1	;FIRST OPERATOR
+O15	EQU	OBASE+15;LAST OPERATOR
+;
+;	MAIN STATEMENT PROCESSING LOOP
+	XRA	A
+	STA	PASS	;SET TO PASS 0 INITIALLY
+	CALL	INISY	;INITIALIZE THE SYMBOL TABLE
+RESTART:	;PASS LOOP GOES FROM 0 TO 1
+	CALL	INITS	;INITIALIZE THE SCANNER
+	CALL	SETUP	;SET UP THE INPUT FILE
+	LXI	H,0
+	SHLD	SYLAB	;ASSUME NO STARTING LABEL
+	SHLD	FPC
+	SHLD	ASPC
+	SHLD	EPC	;END PC
+;
+SCNEXT:	;SCAN THE NEXT INPUT ITEM
+	CALL	SCAN
+SCN0:	LDA	TOKEN
+	CPI	NUMB	;SKIP LEADING NUMBERS FROM LINE EDITORS
+	JZ	SCNEXT
+	CPI	SPECL	;MAY BE PROCESSOR TECH'S COMMENT
+	JNZ	SCN1
+;	SPECIAL CHARACTER, CHECK FOR *
+	LDA	ACCUM
+	CPI	'*'
+	JNZ	CHEND	;END OF LINE IF NOT *
+;	* FOUND, NO PRECEDING LABEL ALLOWED
+	CALL	SETLA
+	JNZ	STERR	;ERROR IF LABEL
+	JMP	CHEN1	;SCAN THE COMMENT OTHERWISE
+;
+SCN1:	;NOT NUMBER OR SPECIAL CHARACTER, CHECK FOR IDENTIFIER
+	CPI	IDEN
+	JNZ	STERR	;ERROR IF NOT
+;
+;	IDENTIFIER FOUND, MAY BE LABEL, OPCODE, OR MACRO
+	CALL	BGET	;BINARY SEARCH FIXED DATA
+	JZ	CHKPT	;CHECK FOR PSEUDO OR REAL OPERATOR
+;
+;	BINARY SEARCH WAS UNSUCCESSFUL, CHECK FOR MACRO
+	CALL	LOOKUP
+	CALL	FOUND
+	JNZ	LFOUN	;NZ FLAG SET IF FOUND
+;
+;	NOT FOUND, ENTER IT
+	CALL	ENTER	;THIS MUST BE PASS 0
+	LDA	PASS
+	ORA	A
+	CNZ	ERRP	;PHASE ERROR IF NOT
+	JMP	SETSY	;SET SYLAB
+;
+;	ITEM WAS FOUND, CHECK FOR MACRO
+LFOUN:	CALL	GETTY
+	CPI	MACT
+	JNZ	SETSY
+;
+;	MACRO DEFINITION FOUND, EXPAND MACRO
+	CALL	ERRN	;NOT CURRENTLY IMPLEMENTED
+	JMP	CHEN1	;SCANS TO END OF CURRENT LINE
+;
+SETSY:	;LABEL FOUND - IS IT THE ONLY ONE?
+	LHLD	SYLAB
+	MOV	A,L
+	ORA	H
+	CNZ	ERRL	;LABEL ERROR IF NOT
+	LHLD	SYADR	;ADDRESS OF SYMBOL
+	SHLD	SYLAB	;MARK AS LABEL FOUND
+;
+;	LABEL FOUND, SCAN OPTIONAL ':'
+	CALL	SCAN
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	SCN0	;SKIP NEXT SCAN IF NOT SPECIAL
+	LDA	ACCUM
+	CPI	':'
+	JNZ	SCN0
+	JMP	SCNEXT	;TO IGNORE ':'
+;
+;	BINARY SEARCH FOUND SYMBOL, CHECK FOR PSEUDO OR REAL OP
+CHKPT:	CPI	PT	;PSEUDO OPCODE?
+	JNZ	CHKOT
+;
+;	PSEUDO OPCODE FOUND, BRANCH TO CASES
+	MOV	E,B	;B HAS PARTICULAR OPERATOR NUMBER
+	MVI	D,0	;DOUBLE PRECISION VALUE TO D,E
+	DCX	D	;BIASED BY +1
+	LXI	H,PTTAB	;BASE OF JUMP TABLE
+	DAD	D
+	DAD	D
+	MOV	E,M
+	INX	H
+	MOV	H,M
+	MOV	L,E
+	PCHL		;JUMP INTO TABLE
+;
+PTTAB:	;PSEUDO OPCODE JUMP TABLE
+	DW	SDB	;DB
+	DW	SDS	;DS
+	DW	SDW	;DW
+	DW	SEND	;END
+	DW	SENDIF	;ENDIF
+	DW	SENDM	;ENDM
+	DW	SEQU	;EQU
+	DW	SIF	;IF
+	DW	SMACRO	;MACRO
+	DW	SORG	;ORG
+	DW	SSET	;SET
+	DW	STITLE	;TITLE
+;
+SDB:
+	CALL	FILAB	;SET LABEL FOR THIS LINE TO ASPC
+SDB0:
+	CALL	SCAN	;PAST DB TO NEXT ITEM
+	LDA	TOKEN	;LOOK FOR LONG STRING
+	CPI	STRNG
+	JNZ	SDBC	;SKIP IF NOT STRING
+	LDA	ACCLEN
+	DCR	A	;LENGTH 1 STRING?
+	JZ	SDBC
+;	LENGTH 0,2,... STRING
+	MOV	B,A
+	INR	B
+	INR	B	;BECOMES 1,3,... FOR 0,2,... LENGTHS
+	LXI	H,ACCUM	;ADDRESS CHARACTERS IN STRING
+SDB1:	DCR	B	;COUNT DOWN TO ZERO
+	JZ	SDB2	;SCAN DELIMITER AT END OF STRING
+	PUSH	B	;SAVE COUNT
+	MOV	B,M	;GET CHARACTER
+	INX	H
+	PUSH	H	;SAVE ACCUM POINTER
+	CALL	FILHB	;SEND TO HEX FILE
+	POP	H
+	POP	B
+	JMP	SDB1
+SDB2:	CALL	SCAN	;TO THE DELIMITER
+	JMP	SDB3
+;
+;	NOT A LONG STRING
+SDBC:	CALL	OPAND	;COMPUTE OPERAND
+	LHLD	EVALUE	;VALUE TO H,L
+	MOV	A,H
+	ORA	A	;HIGH ORDER MUST BE ZERO
+	CNZ	ERRD	;DATA ERROR
+	MOV	B,L	;GET LOW BYTE
+	CALL	FILHB
+SDB3:	;END OF ITEM - UPDATE ASPC
+	CALL	SETAS	;SET ASPC TO FPC
+	CALL	DELIM
+	CPI	','
+	JZ	SDB0	;FOR ANOTHER ITEM
+	JMP	CHEND	;CHECK END OF LINE SYNTAX
+;
+SDS:
+	CALL	FILAB	;HANDLE LABEL IF IT OCCURRED
+	CALL	PADD	;PRINT ADDRESS
+	CALL	EXP16	;SCAN AND GET 16BIT OPERAND
+	XCHG		;TO D,E
+	LHLD	ASPC	;CURRENT PSEUDO PC
+	DAD	D	;+EXPRESSION
+	SHLD	ASPC
+	SHLD	FPC	;NEXT TO FILL
+	JMP	CHEND
+;
+SDW:
+	CALL	FILAB	;HANDLE OPTIONAL LABEL
+SDW0:
+	CALL	EXP16	;GET 16BIT OPERAND
+	PUSH	H	;SAVE A COPY
+	MOV	B,L	;LOW BYTE FIRST
+	CALL	FILHB	;SEND LOW BYTE
+	POP	H	;RECLAIM A COPY
+	MOV	B,H	;HIGH BYTE NEXT
+	CALL	FILHB	;SEND HIGH BYTE
+	CALL	SETAS	;SET ASPC=FPC
+	CALL	DELIM	;CHECK DELIMITER SYNTAX
+	CPI	','
+	JZ	SDW0	;GET MORE DATA
+	JMP	CHEND
+;
+SEND:
+	CALL	FILAB
+	CALL	PADD	;WRITE LAST LOC
+	LDA	PBUFF
+	CPI	' '
+	JNZ	CHEND
+	CALL	EXP16	;GET EXPRESSION IF IT'S THERE
+	LDA	PBUFF
+	CPI	' '
+	JNZ	SEND0
+	SHLD	EPC	;EXPRESSION FOUND, STORE IT FOR LATER
+SEND0:	MVI	A,' '
+	STA	PBUFF	;CLEAR ERROR, IF IT OCCURRED
+	CALL	SCAN	;CLEAR CR
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	STERR
+	LDA	ACCUM
+	CPI	LF
+	JNZ	STERR
+	JMP	ENDAS	;END OF ASSEMBLER
+;
+SENDIF:
+	JMP	POEND
+;
+SENDM:
+	CALL	ERRN
+	JMP	POEND
+;
+SEQU:
+	CALL	SETLA
+	JZ	STERR	;MUST BE A LABEL
+	LHLD	ASPC	;HOLD TEMP ASPC
+	PUSH	H	;IN STACK
+	CALL	EXP16	;GET 16BIT OPERAND
+	SHLD	ASPC	;VALUE OF EXPRESSION
+	CALL	FILAB
+	CALL	PADDR	;COMPUTED VALUE
+	LXI	H,PBUFF+6	;SPACE AFTER VALUE
+	MVI	M,'='
+	POP	H	;REAL ASPC
+	SHLD	ASPC	;CHANGE BACK
+	JMP	CHEND
+;
+SIF:
+	CALL	FILAB	;IN CASE OF LABEL
+	CALL	EXP16	;GET IF EXPRESSION
+	LDA	PBUFF
+	CPI	' '
+	JNZ	CHEND	;SKIP IF ERROR
+	MOV	A,L	;GET LSB
+	RAR
+	JC	CHEND	;TRUE IF CARRY BIT SET
+;
+;	SKIP TO EOF OR ENDIF
+SIF0:	CALL	SCAN
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	SIF1
+	LDA	ACCUM
+	CPI	EOF
+	MVI	A,'B'	;BALANCE ERROR
+	CZ	PERR
+	JZ	ENDAS
+	JMP	SIF0	;FOR ANOTHER
+SIF1:	;NOT A SPECIAL CHARACTER
+	CPI	IDEN
+	JNZ	SIF0	;NOT AN IDENTIFIER
+	CALL	BGET	;LOOK FOR ENDIF
+	JNZ	SIF0	;NOT FOUND
+	CPI	PT	;PSEUDO OP?
+	JNZ	SIF0
+	MOV	A,B	;GET OPERATOR NUMBER
+	CPI	PENDIF	;ENDIF?
+	JNZ	SIF0	;GET ANOTHER TOKEN
+	JMP	POEND	;OK, CHECK END OF LINE
+;
+SMACRO:
+	CALL	ERRN
+	JMP	CHEND
+;
+SORG:
+	CALL	EXP16
+	LDA	PBUFF
+	CPI	' '
+	JNZ	CHEND	;SKIP ORG IF ERROR
+	SHLD	ASPC	;CHANGE PC
+	SHLD	FPC	;CHANGE NEXT TO FILL
+	CALL	FILAB	;IN CASE OF LABEL
+	CALL	PADD
+	JMP	CHEND
+;
+SSET:
+	CALL	SETLA
+	JZ	STERR	;MUST BE LABELLED
+;
+	CALL	GETTY
+	CPI	SETT
+	CNZ	ERRL	;LABEL ERROR
+	MVI	A,SETT
+	CALL	SETTY	;REPLACE TYPE WITH 'SET'
+	CALL	EXP16	;GET THE EXPRESSION
+	PUSH	H	;SAVE IT
+	CALL	SETLA	;RE-ADDRESS LABEL
+	POP	H	;RECLAIM IT
+	CALL	SETVAL
+	LXI	H,0
+	SHLD	SYLAB	;PREVENT LABEL PROCESSING
+	JMP	CHEND
+;
+;
+STITLE:
+	CALL	ERRN	;NOT IMPLEMENTED
+;
+POEND:	;PSEUDO OPERATOR END - SCAN TO NEXT TOKEN
+	CALL	SCAN
+	JMP	CHEND
+;
+;	NOT A PSEUDO OPCODE, CHECK FOR REAL OPCODE
+CHKOT:	SUI	O1	;BASE OF OPCODES
+	CPI	O15	;PAST LAST OPCODE?
+	JNC	STERR	;STATEMENT ERROR IF SO
+;
+;	FOUND OPCODE, COMPUTE INDEX INTO TABLE AND JUMP TO CASE
+	MOV	E,A
+	MVI	D,0
+	LXI	H,OPTAB
+	DAD	D
+	DAD	D
+	MOV	E,M
+	INX	H
+	MOV	H,M
+	MOV	L,E
+	PCHL		;JUMP TO CASE
+;
+OPTAB:	;OPCODE CATEGORIES
+	DW	SSIMP	;SIMPLE
+	DW	SLXI	;LXI
+	DW	SDAD	;DAD
+	DW	SPUSH	;PUSH/POP
+	DW	SJMP	;JMP/CALL
+	DW	SMOV	;MOV
+	DW	SMVI	;MVI
+	DW	SACCI	;ACCUM IMMEDIATE
+	DW	SLDAX	;LDAX/STAX
+	DW	SLHLD	;LHLD/SHLD/LDA/STA
+	DW	SACCR	;ACCUM-REGISTER
+	DW	SINC	;INC/DCR
+	DW	SINX	;INX/DCX
+	DW	SRST	;RESTART
+	DW	SIN	;IN/OUT
+;
+SSIMP:	;SIMPLE OPERATION CODES
+	CALL	FILHB	;SEND HEX VALUE TO MACHINE CODE FILE
+	CALL	SCAN	;TO NEXT TOKEN
+	JMP	INCPC
+;
+SLXI:	;LXI H,16B
+	CALL	SHDREG	;SCAN DOUBLE PRECISION REGISTER
+	CALL	CHCOM	;CHECK FOR COMMA FOLLOWING REGISTER
+	CALL	SETADR	;SCAN AND EMIT DOUBLE PRECISION OPERAND
+	JMP	INCPC
+;
+SDAD:	;DAD B
+	CALL	SHDREG	;SCAN AND EMIT DOUBLE PRECISION REGISTER
+	JMP	INCPC
+;
+SPUSH:	;PUSH B POP D
+	CALL	SHREG	;SCAN SINGLE PRECISION REGISTER TO A
+	CPI	111000B	;MAY BE PSW
+	JZ	SPU0
+;	NOT PSW, MUST BE B,D, OR H
+	ANI	001000B	;LOW BIT MUST BE 0
+	CNZ	ERRR	;REGISTER ERROR IF NOT
+SPU0:	MOV	A,C	;RECALL REGISTER AND MASK IN CASE OF ERROR
+	ANI	110000B
+	ORA	B	;MASK IN OPCODE FOR PUSH OR POP
+	JMP	FILINC	;FILL HEX VALUE AND INCREMENT PC
+;
+SJMP:	;JMP 16B/ CALL 16B
+	CALL	FILHB	;EMIT JMP OR CALL OPCODE
+	CALL	SETADR	;EMIT 16BIT OPERAND
+	JMP	INCPC
+;
+SMOV:	;MOV A,B
+	CALL	SHREG
+	ORA	B	;MASK IN OPCODE
+	MOV	B,A	;SAVE IN B TEMPORARILY
+	CALL	CHCOM	;MUST BE COMMA SEPARATOR
+	CALL	EXP3	;VALUE MUST BE 0-7
+	ORA	B	;MASK IN OPCODE
+	JMP	FILINC
+;
+SMVI:	;MVI A,8B
+	CALL	SHREG
+	ORA	B	;MASK IN OPCODE
+	CALL	FILHEX	;EMIT OPCODE
+	CALL	CHCOM	;SCAN COMMA
+	CALL	SETBYTE	;EMIT 8BIT VALUE
+	JMP	INCPC
+;
+SACCI:	;ADI 8B
+	CALL	FILHB	;EMIT IMMEDIATE OPCODE
+	CALL	SETBYTE	;EMIT 8BIT OPERAND
+	JMP	INCPC
+;
+SLDAX:	;LDAX B/STAX D
+	CALL	SHREG
+	ANI	101000B	;MUST BE B OR D
+	CNZ	ERRR	;REGISTER ERROR IF NOT
+	MOV	A,C	;RECOVER REGISTER NUMBER
+	ANI	010000B	;CHANGE TO B OR D IF ERROR
+	ORA	B	;MASK IN OPCODE
+	JMP	FILINC	;EMIT OPCODE
+;
+SLHLD:	;LHLD 16B/ SHLD 16B/ LDA 16B/ STA 16B
+	CALL	FILHB	;EMIT OPCODE
+	CALL	SETADR	;EMIT OPERAND
+	JMP	INCPC
+;
+SACCR:	;ADD B
+	CALL	EXP3	;RIGHT ADJUSTED 3BIT VALUE FOR REGISTER
+	ORA	B	;MASK IN OPCODE
+	JMP	FILINC
+;
+SINC:	;INR B/DCR D
+	CALL	SHREG	;GET REGISTER
+	ORA	B
+	JMP	FILINC
+;
+SINX:	;INX H/DCX B
+	CALL	SHREG
+	ANI	001000B	;MUST BE B D M OR SP
+	CNZ	ERRR	;REGISTER ERROR IF NOT
+	MOV	A,C	;RECOVER REGISTER
+	ANI	110000B	;IN CASE OF ERROR
+	ORA	B	;MASK IN OPCODE
+	JMP	FILINC
+;
+SRST:	;RESTART 4
+	CALL	SHREG	;VALUE IS 0-7
+	ORA	B	;OPCODE MASKED
+	JMP	FILINC
+;
+SIN:	;IN 8B/OUT 8B
+	CALL	FILHB	;EMIT OPCODE
+	CALL	SETBYTE	;EMIT 8BIT OPERAND
+	JMP	INCPC
+;
+FILINC:	;FILL HEX VALUE FROM A BEFORE INCREMENTING PC
+	CALL	FILHEX
+;
+INCPC:	;CHANGE ASSEMBLER'S PSEUDO PROGRAM COUNTER
+	CALL	FILAB	;SET ANY LABELS WHICH OCCUR ON THE LINE
+	CALL	SETAS	;ASPC=FPC
+	JMP	CHEND	;END OF LINE SCAN
+;
+;
+;	UTILITY SUBROUTINES FOR OPERATION CODES
+;
+DELIM:	;CHECK DELIMITER SYNTAX FOR DATA STATEMENTS
+	LDA	TOKEN
+	CPI	SPECL
+	CNZ	ERRD
+	LDA	ACCUM
+	CPI	','
+	RZ
+	CPI	';'
+	RZ
+	CPI	CR
+	CNZ	ERRD
+	RET
+;
+EXP16:	;GET 16BIT VALUE TO H,L
+	PUSH	B
+	CALL	SCAN	;START SCANNING OPERAND FIELD
+	CALL	OPAND
+	LHLD	EVALUE	;VALUE TO H,L
+	POP	B
+	RET
+;
+EXP8:	;GET 8BIT VALUE TO REG A
+	CALL	EXP16
+	MOV	A,H
+	ORA	A
+	CNZ	ERRV	;VALUE ERROR IF HIGH BYTE NOT ZERO
+	MOV	A,L
+	RET
+;
+EXP3:	;GET 3BIT VALUE TO REG A
+	CALL	EXP8
+	CPI	8
+	CNC	ERRV	;VALUE ERROR IF >=8
+	ANI	111B	;REDUCE IF ERROR OCCURS
+	RET
+;
+SHREG:	;GET 3BIT VALUE AND SHIFT LEFT BY 3
+	CALL	EXP3
+	RAL
+	RAL
+	RAL
+	ANI	111000B
+	MOV	C,A	;COPY TO C
+	RET
+;
+SHDREG:	;GET DOUBLE REGISTER TO A
+	CALL	SHREG
+	ANI	001000B	;CHECK FOR A,C,E, OR L
+	CNZ	ERRR	;REGISTER ERROR
+	MOV	A,C	;RECOVER REGISTER
+	ANI	110000B	;FIX IT IF ERROR OCCURRED
+	ORA	B	;MASK OPCODE
+	JMP	FILHEX	;EMIT IT
+;
+SETBYTE:	;EMIT 16BIT OPERAND
+	CALL	EXP8
+	JMP	FILHEX
+;
+SETADR:	;EMIT 16BIT OPERAND
+	CALL	EXP16
+	JMP	FILADR
+;
+CHCOM:	;CHECK FOR COMMA FOLLOWING EXPRESSION
+	PUSH	PSW
+	PUSH	B
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	COMER
+;	SPECIAL CHARACTER, CHECK FOR COMMA
+	LDA	ACCUM
+	CPI	','
+	JZ	COMRET	;RETURN IF COMMA FOUND
+COMER:	;COMMA ERROR
+	MVI	A,'C'
+	CALL	PERR
+COMRET:
+	POP	B
+	POP	PSW
+	RET
+;
+CHEND:	;END OF LINE CHECK
+	CALL	FILAB	;IN CASE OF A LABEL
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	STERR	;MUST BE A SPECIAL CHARACTER
+	LDA	ACCUM
+	CPI	CR	;CARRIAGE RETURN
+	JNZ	CHEN0
+;	CARRIAGE RETURN FOUND, SCAN PICKS UP LF AND PUSHES LINE
+	CALL	SCAN
+	JMP	SCNEXT
+;
+CHEN0:	;NOT CR, CHECK FOR COMMENT
+	CPI	';'
+	JNZ	CHEN2
+	CALL	FILAB	;IN CASE LABELLED EMPTY LINE
+;	CLEAR COMMENT TO END OF LINE
+CHEN1:	CALL	SCAN
+	LDA	TOKEN
+	CPI	SPECL
+	JNZ	CHEN1
+	LDA	ACCUM
+	CPI	LF
+	JZ	SCNEXT
+	CPI	EOF
+	JZ	ENDAS	;END OF ASSEMBLY IF EOF
+	CPI	'!'
+	JZ	SCNEXT	;LOGICAL END OF LINE
+	JMP	CHEN1	;NONE OF THE ABOVE
+;
+;	NOT CR OR LF, MAY BE LOGICAL END OF LINE
+CHEN2:	CPI	'!'
+	JZ	SCNEXT
+	CPI	EOF
+	JZ	ENDAS
+;
+;	STATEMENT ERROR IN OPERAND FIELD
+STERR:	MVI	A,'S'
+	CALL	PERR
+	JMP	CHEN1	;TO DUMP LINE
+;
+DIFF:	;COMPUTE DE-HL TO HL
+	MOV	A,E
+	SUB	L
+	MOV	L,A
+	MOV	A,D
+	SBB	H
+	MOV	H,A
+	RET
+;
+ENDAS:	;END OF ASSEMBLY FOR THIS PASS
+	LXI	H,PASS
+	MOV	A,M
+	INR	M	;PASS NUMBER INCREMENTED
+	ORA	A
+	JZ	RESTART
+	CALL	SCAN	;TO CLEAR LAST LINE FEED
+	CALL	PADD	;WRITE LAST ADDRESS
+	LXI	H,PBUFF+5
+	MVI	M,CR	;SET TO CR FOR END OF MESSAGE
+	LXI	H,PBUFF+1
+	CALL	PCON	;PRINT LAST ADDRESS
+;
+;	COMPUTE REMAINING SPACE
+	LHLD	SYTOP
+	XCHG
+	LHLD	SYBAS
+	CALL	DIFF	;DIFFERENCE TO H,L
+	PUSH	H	;SYTOP-SYBAS TO STACK
+	LHLD	SYMAX
+	XCHG
+	LHLD	SYBAS
+	CALL	DIFF	;SYMAX-SYBAS TO H,L
+	MOV	E,H
+	MVI	D,0	;DIVIDED BY 256
+	POP	H	;SYTOP-SYBAS TO H,L
+	CALL	DIVF	;RESULT TO DE
+	XCHG
+	CALL	PADDR	;PRINT H,L TO PBUFF
+	LXI	H,PBUFF+5	;MESSAGE
+	LXI	D,EMSG		;END MESSAGE
+ENDA0:	LDAX	D
+	ORA	A	;ZERO?
+	JZ	ENDA1
+	MOV	M,A
+	INX	H
+	INX	D
+	JMP	ENDA0
+;
+EMSG:	DB	'H USE FACTOR',CR,0
+;
+ENDA1:	LXI	H,PBUFF+2	;BEGINNING OF RATIO
+	CALL	PCON
+	LHLD	EPC
+	SHLD	FPC	;END PROGRAM COUNTER
+	JMP	EOR
+;
+;	UTILITY SUBROUTINES
+COMDH:	;COMPARE D,E WITH H,L FOR EQUALITY (NZ FLAG IF NOT EQUAL)
+	MOV	A,D
+	CMP	H
+	RNZ
+	MOV	A,E
+	CMP	L
+	RET
+;
+SETAS:	;ASPC=FPC
+	LHLD	FPC
+	SHLD	ASPC
+	RET
+;
+SETLA:	;SYADR=SYLAB, FOLLOWED BY CHECK FOR ZERO
+	LHLD	SYLAB
+	SHLD	SYADR
+	CALL	FOUND
+	RET
+;
+FILAB:	;FILL LABEL VALUE WITH CURRENT ASPC, IF LABEL FOUND
+	CALL	SETLA
+	RZ		;RETURN IF NO LABEL DETECTED
+;
+;	LABEL FOUND, MUST BE DEFINED ON PASS-1
+	LXI	H,0
+	SHLD	SYLAB	;TO MARK NEXT STATEMENT WITH NO LABEL
+	LDA	PASS
+	ORA	A
+	JNZ	FIL1
+;
+;	PASS 0
+	CALL	GETTY
+	PUSH	PSW	;SAVE A COPY OF TYPE
+	ANI	111B	;CHECK FOR UNDEFINED
+	CNZ	ERRL	;LABEL ERROR
+	POP	PSW	;RESTORE TYPE
+	ORI	PLABT	;SET TO LABEL TYPE
+	CALL	SETTY	;SET TYPE FIELD
+	LHLD	ASPC	;GET CURRENT PC
+	CALL	SETVAL	;PLACE INTO VALUE FIELD
+	RET
+;
+FIL1:	;CHECK FOR DEFINED VALUE
+	CALL	GETTY
+	ANI	111B
+	CZ	ERRP	;PHASE ERROR
+;	GET VALUE AND COMPARE WITH ASPC
+	CALL	GETVAL	;TO H,L
+	XCHG
+	LHLD	ASPC
+	CALL	COMDH
+	CNZ	ERRP	;PHASE ERROR IF NOT THE SAME
+	RET
+;
+FILHEX:	;WRITE HEX BYTE IN REGISTER A TO MACHINE CODE FILE IF PASS-1
+	MOV	B,A
+FILHB:	LDA	PASS
+	ORA	A
+	MOV	A,B
+	JZ	FILHI
+;
+;	PASS - 1, WRITE HEX AND PRINT DATA
+	PUSH	B	;SAVE A COPY
+	CALL	DHEX	;INTO MACHINE CODE FILE
+;	MAY BE COMPLETELY EMPTY LINE, SO CHECK ADDRESS
+	LDA	PBUFF+1
+	CPI	' '
+	LHLD	ASPC
+	CZ	PADDR	;PRINT ADDRESS FIELD
+;
+	LDA	NBP
+	CPI	NBMAX	;TRUNCATE CODE IF TOO MUCH ON THIS LINE
+	POP	B	;RECALL HEX DIGIT
+	JNC	FILHI
+;	ROOM FOR DIGIT ON THIS LINE
+	MOV	A,B
+	CALL	WHEXB	;WRITE HEX BYTE TO PRINT LINE
+FILHI:	LHLD	FPC
+	INX	H
+	SHLD	FPC	;READY FOR NEXT BYTE
+	RET
+;
+FILADR:	;EMIT DOUBLE PRECISION VALUE FROM H,L
+	PUSH	H	;SAVE A COPY
+	MOV	B,L
+	CALL	FILHB	;LOW BYTE EMITTED
+	POP	H	;RECOVER A COPY OF H,L
+	MOV	B,H
+	JMP	FILHB	;EMIT HIGH BYTE AND RETURN
+;
+;	UTILITY FUNCTIONS FOR PRINTING HEX ADDRESSES AND DATA
+CHEX:	;CONVERT TO HEX
+	ADI	'0'
+	CPI	'0'+10
+	RC
+	ADI	'A'-'0'-10
+	RET
+;
+WHEXN:	;WRITE HEX NIBBLE
+	CALL	CHEX	;CONVERT TO ASCII FROM HEX
+	LXI	H,NBP
+	MOV	E,M	;NEXT POSITION TO PRINT
+	MVI	D,0	;DOUBLE PRECISION
+	INR	M	;NBP=NBP+1
+	LXI	H,PBUFF
+	DAD	D
+	MOV	M,A	;STORE IN PRINT BUFFER
+	RET
+;
+WHEXB:	;WRITE HEX BYTE TO PRINT BUFFER
+	PUSH	PSW
+	RAR
+	RAR
+	RAR
+	RAR
+	ANI	0FH	;HIGH ORDER NIBBLE NORMALIZE IN A
+	CALL	WHEXN	;WRITE IT
+	POP	PSW
+	ANI	0FH
+	JMP	WHEXN	;WRITE AND RETURN
+;
+PADD:	LHLD	ASPC
+PADDR:	;PRINT ADDRESS FIELD OF PRINT LINE FROM H,L
+	XCHG
+	LXI	H,NBP	;INITIALIZE NEXT TO FILL
+	PUSH	H	;SAVE A COPY OF NBP'S ADDRESS
+	MVI	M,1
+	MOV	A,D	;PRINT HIGH BYTE
+	PUSH	D	;SAVE A COPY
+	CALL	WHEXB
+	POP	D
+	MOV	A,E
+	CALL	WHEXB
+	POP	H	;ADDRESSING NBP
+	INR	M	;SKIP A SPACE AFTER ADDRESS FIELD
+	RET
+;
+ERRR:	;EMIT REGISTER ERROR
+	PUSH	PSW
+	PUSH	B
+	MVI	A,'R'
+	CALL	PERR
+	POP	B
+	POP	PSW
+	RET
+;
+ERRV:	;EMIT VALUE ERROR
+	PUSH	PSW
+	PUSH	H
+	MVI	A,'V'
+	CALL	PERR
+	POP	H
+	POP	PSW
+	RET
+;
+ERRD:	PUSH	PSW
+	MVI	A,'D'	;DATA ERROR
+	JMP	ERR
+;
+ERRP:	PUSH	PSW
+	MVI	A,'P'
+	JMP	ERR
+;
+ERRL:	PUSH	PSW
+	MVI	A,'L'	;LABEL ERROR
+	JMP	ERR
+;
+ERRN:	PUSH	PSW
+	MVI	A,'N'	;NOT IMPLEMENTED
+;
+ERR:
+	CALL	PERR
+	POP	PSW
+	RET
+;
+SYLAB:	DS	2	;ADDRESS OF LINE LABEL
+EPC:	DS	2	;END PC VALUE
+NBP:	DS	1	;NEXT BYTE POSITION TO WRITE FOR MACHINE CODE
+	END
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/asm.sub

@@ -0,0 +1,52 @@
+mac as0com
+vax as0com.prn $$stan
+vax as0com.sym $$stan
+era *.prn
+era *.sym
+mac as1io
+vax as1io.prn $$stan
+vax as1io.sym $$stan
+era *.prn
+era *.sym
+mac as2scan
+vax as2scan.prn $$stan
+vax as2scan.sym $$stan
+era *.prn
+era *.sym
+mac as3sym
+vax as3sym.prn $$stan
+vax as3sym.sym $$stan
+era *.prn
+era *.sym
+pip as00.hex=as0com.hex[i],as1io.hex[i],as2scan.hex[i],as3sym.hex[h]
+mac as0com $$pzsz+r
+mac as1io $$pzsz+r
+mac as2scan $$pzsz+r
+mac as3sym $$pzsz+r
+pip as01.hex=as0com.hex[i],as1io.hex[i],as2scan.hex[i],as3sym.hex[h]
+mac as4sear
+vax as4sear.prn $$stan
+vax as4sear.sym $$stan
+era *.prn
+era *.sym
+mac as5oper
+vax as5oper.prn $$stan
+vax as5oper.sym $$stan
+era *.prn
+era *.sym
+mac as6main
+vax as6main.prn $$stan
+vax as6main.sym $$stan
+era *.prn
+era *.sym
+pip as10.hex=as4sear.hex[i],as5oper.hex[i],as6main.hex[h]
+mac as4sear $$pzsz+r
+mac as5oper $$pzsz+r
+mac as6main $$pzsz+r
+pip as11.hex=as4sear.hex[i],as5oper.hex[i],as6main.hex[h]
+pip as0.hex=as00.hex[i],as10.hex[h]
+pip as1.hex=as01.hex[i],as11.hex[h]
+pip asm.hex=as0.hex,as1.hex
+genmod asm.hex asm.prl $$1000
+era *.hex
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/ddt.sub

@@ -0,0 +1,40 @@
+mac ddt1asm
+vax ddt1asm.prn $$stan
+vax ddt1asm.sym $$stan
+era ddt1asm0.hex
+ren ddt1asm0.hex=ddt1asm.hex
+mac ddt1asm $$pzsz+r
+era ddt1asm1.hex
+ren ddt1asm1.hex=ddt1asm.hex
+mac ddt2mon
+vax ddt2mon.prn $$stan
+vax ddt2mon.sym $$stan
+era ddt2mon0.hex
+ren ddt2mon0.hex=ddt2mon.hex
+mac ddt2mon $$pzsz+r
+era ddt2mon1.hex
+ren ddt2mon1.hex=ddt2mon.hex
+pip relddt0.hex=ddt1asm0.hex[i],ddt2mon0.hex[h]
+pip relddt1.hex=ddt1asm1.hex[i],ddt2mon1.hex[h]
+pip relddt.hex=relddt0.hex,relddt1.hex
+genmod relddt.hex relddt.com
+genhex relddt 100
+era relddt0.hex
+ren relddt0.hex=relddt.hex
+genhex relddt 200
+era relddt1.hex
+ren relddt1.hex=relddt.hex
+mac ddt0mov
+vax ddt0mov.prn $$stan
+vax ddt0mov.sym $$stan
+era ddt0mov0.hex
+ren ddt0mov0.hex=ddt0mov.hex
+mac ddt0mov $$pzsz+r
+era ddt0mov1.hex
+ren ddt0mov1.hex=ddt0mov.hex
+pip relddt0.hex=relddt0.hex[i],ddt0mov0.hex[h]
+pip relddt1.hex=relddt1.hex[i],ddt0mov1.hex[h]
+pip relddt.hex=relddt0.hex,relddt1.hex
+genmod relddt.hex rdt.prl $$z1500
+prlcom rdt.prl ddt.com
+

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE 2/ASM/DDT/ddt0mov.asm

@@ -0,0 +1,101 @@
+	TITLE	'DDT RELOCATOR PROGRAM'
+;	DDT RELOCATOR PROGRAM, INCLUDED WITH THE MODULE TO PERFORM
+;	THE MOVE FROM 200H TO THE DESTINATION ADDRESS
+VERSION	EQU	20	;2.0
+;
+;	COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981
+;	DIGITAL RESEARCH
+;	BOX 579 PACIFIC GROVE
+;	CALIFORNIA 93950
+;
+
+;	Revised:
+;	  14 Sept 81  Thomas Rolander
+
+	org	0
+base	equ	$
+
+	ORG	100H
+STACK	EQU	base+200H
+BDOS	EQU	base+05H
+PRNT	EQU	9	;BDOS PRINT FUNCTION
+MODULE	EQU	base+200H	;MODULE ADDRESS
+;
+;	LXI	B,0	;ADDRESS FIELD FILLED-IN WHEN MODULE BUILT
+	db	01h
+	org	103h
+	JMP	START
+	DB	'COPYRIGHT (C) 1981, DIGITAL RESEARCH      '
+SIGNON:	DB	'[MP/M II] DDT VERS '
+	DB	VERSION/10+'0','.'
+	DB	VERSION MOD 10 + '0','$'
+START:	LXI	SP,STACK
+	PUSH	B
+	PUSH	B
+	LXI	D,SIGNON
+	MVI	C,PRNT
+	CALL	BDOS
+	POP	B	;RECOVER LENGTH OF MOVE
+	LXI	H,BDOS+2;ADDRESS FIELD OF JUMP TO BDOS (TOP MEMORY)
+	MOV	A,M	;A HAS HIGH ORDER ADDRESS OF MEMORY TOP
+	DCR	A	;PAGE DIRECTLY BELOW BDOS
+	SUB	B	;A HAS HIGH ORDER ADDRESS OF RELOC AREA
+	MOV	D,A
+	MVI	E,0	;D,E ADDRESSES BASE OF RELOC AREA
+	PUSH	D	;SAVE FOR RELOCATION BELOW
+;
+	LXI	H,MODULE;READY FOR THE MOVE
+MOVE:	MOV	A,B	;BC=0?
+	ORA	C
+	JZ	RELOC
+	DCX	B	;COUNT MODULE SIZE DOWN TO ZERO
+	MOV	A,M	;GET NEXT ABSOLUTE LOCATION
+	STAX	D	;PLACE IT INTO THE RELOC AREA
+	INX	D
+	INX	H
+	JMP	MOVE
+;
+RELOC:	;STORAGE MOVED, READY FOR RELOCATION
+;	HL ADDRESSES BEGINNING OF THE BIT MAP FOR RELOCATION
+	POP	D	;RECALL BASE OF RELOCATION AREA
+	POP	B	;RECALL MODULE LENGTH
+	PUSH	H	;SAVE BIT MAP BASE IN STACK
+	MOV	H,D	;RELOCATION BIAS IS IN D
+;
+REL0:	MOV	A,B	;BC=0?
+	ORA	C
+	JZ	ENDREL
+;
+;	NOT END OF THE RELOCATION, MAY BE INTO NEXT BYTE OF BIT MAP
+	DCX	B	;COUNT LENGTH DOWN
+	MOV	A,E
+	ANI	111B	;0 CAUSES FETCH OF NEXT BYTE
+	JNZ	REL1
+;	FETCH BIT MAP FROM STACKED ADDRESS
+	XTHL
+	MOV	A,M	;NEXT 8 BITS OF MAP
+	INX	H
+	XTHL		;BASE ADDRESS GOES BACK TO STACK
+	MOV	L,A	;L HOLDS THE MAP AS WE PROCESS 8 LOCATIONS
+REL1:	MOV	A,L
+	RAL		;CY SET TO 1 IF RELOCATION NECESSARY
+	MOV	L,A	;BACK TO L FOR NEXT TIME AROUND
+	JNC	REL2	;SKIP RELOCATION IF CY=0
+;
+;	CURRENT ADDRESS REQUIRES RELOCATION
+	LDAX	D
+	ADD	H	;APPLY BIAS IN H
+	STAX	D
+REL2:	INX	D	;TO NEXT ADDRESS
+	JMP	REL0	;FOR ANOTHER BYTE TO RELOCATE
+;
+ENDREL:	;END OF RELOCATION
+	lxi	b,base
+	mov	a,b
+	dcx	d
+	stax	d
+	POP	D	;CLEAR STACKED ADDRESS
+	MVI	L,0
+	PCHL		;GO TO RELOCATED PROGRAM
+	END
+