DataMuseum.dk

top - metrics - download

    Length: 5888 (0x1700)
    Types: TextFile
    Names: »H1LIB.MAC«

└─⟦f0eb17f9f⟧ Bits:30009437 50004984
    └─⟦d0422dc08⟧ 
        └─⟦this⟧ »H1LIB.MAC« 

TextFile

	TITLE	ProPascal housekeeping library (1)
;
	NAME	('H1LIB')
;
;	Date	30 May 1982.
;
;	Copyright (C) 1981,1982   Prospero Software
;
;	This module contains the essential housekeeping
;	routines for program start and termination,
;	and for error reporting.
;
;
	.Z80
;
	ENTRY	$HINIT,$HTERM
	ENTRY	$MVAIL
	ENTRY	$GVAIL,$WVAIL,$GROVR,$WROVR
	ENTRY	$HPLM,$STKLM
	ENTRY	$FNSEQ,$HCPMV
	ENTRY	$HERR,$PERR,$BDOS
	ENTRY	$MEMRY,$INIX
;
;
	EXT	$FINTX,$FRES,$FREW,$FCLOS
	EXT	$DPRST,$STOP
;
;
;	===============
;
;
FCASIZE	EQU	26
FCBSIZE	EQU	36
;
BASE	EQU	0		; CP/M base address
BOOT	EQU	BASE+0
BDOS	EQU	BASE+5		; BDOS entry point
DEFBUF	EQU	BASE+80H	; default buffer
SETDMA	EQU	1AH		; "set DMA" code
;
;
	COMMON/INPUT/
HINPP:	DS	2
;
	COMMON/OUTPUT/
HOUTP:	DS	2
;
	DSEG
$GVAIL:
GAVLNK:	DS	2
GAVSIZ:	DS	2
;
$WVAIL:
WAVLNK:	DS	2
;
$GROVR:	DS	2
;
$WROVR:	DS	2
;
$HPLM:	DS	2
;
$STKLM:	DS	2		; for stack limit check
;
$INIX:	DS	2		; IX value at outer level
;
$FNSEQ:	DS	2		; for sequential file naming
;
$HCPMV:	DS	2		; for CP/M version number
;
;
;	===================
;
	CSEG
;
;
$MEMRY:	DW	0		; filled in by linker
;
;
;
;	Routine	$HINIT		Initial program startup.
;
;	Calling sequence is:
;		LD	HL,$+6
;		JP	$HINIT
;
INITHP	EQU	1024		; initial heap size
GAP	EQU	256		; minimum gap between heap & SP
NIL	EQU	80H
;
;
;
$HINIT:
	LD	SP,(BDOS+1)		; set SP
;
	LD	B,6			; start of BDOS is 6 bytes
DECSP:	DEC	SP			; .. below entry address
	DJNZ	DECSP
;
	LD	IX,126
	ADD	IX,SP			; IX for program
	LD	($INIX),IX
;
	PUSH	HL			; link for return
;
;	Set up INPUT and OUTPUT
;
	LD	HL,($MEMRY)		; start of workspace
	LD	BC,FCASIZE+FCBSIZE
	LD	(HINPP),HL
	ADD	HL,BC
	LD	(HOUTP),HL
	ADD	HL,BC
;
;	Initial heap space
;
	LD	(GAVLNK),HL
	LD	DE,INITHP
	ADD	HL,DE		; "hplim := sysmem + 1024"
	LD	($HPLM),HL
;
	LD	BC,GAP
	ADD	HL,BC		; set $STKLM to complement of
	LD	A,H		; heap limit plus gap
	CPL
	LD	H,A
	LD	A,L
	CPL
	LD	L,A
	LD	($STKLM),HL
	ADD	HL,SP
	JR	NC,NOROOM	; not enough to start program
;
;
	LD	HL,0
	LD	(GAVSIZ),HL	; "gavail.size := 0"
;
	LD	HL,(GAVLNK)
	LD	BC,NIL
	LD	(HL),C		; "WITH gavail.link^ DO
	INC	HL		;    BEGIN
	LD	(HL),B		;      link := NIL;
	INC	HL		;      size := 1024;
	LD	BC,INITHP	;    END"
	LD	(HL),C
	INC	HL
	LD	(HL),B
;
	LD	HL,NIL
	LD	(WAVLNK),HL	; "wavail.link := NIL"
;
	LD	HL,$GVAIL
	LD	($GROVR),HL	; "grover := addr(gavail)"
	LD	HL,$WVAIL
	LD	($WROVR),HL	; "wrover := addr(wavail)"
;
;	"Input" and "Output"
;
	LD	HL,(HINPP)
	PUSH	HL
	PUSH	HL
	CALL	$FINTX		; initialise & reset
	CALL	$FRES		; standard file "input"
;
	LD	HL,(HOUTP)
	PUSH	HL
	PUSH	HL
	CALL	$FINTX		; similarly "output"
	CALL	$FREW
;
	LD	HL,0
	LD	($FNSEQ),HL	; file name sequence
	LD	($HCPMV),HL	; version number (see F7LIB)
;
	LD	C,SETDMA	; set "DMA address" to ..
	LD	DE,DEFBUF	; default buffer at base+80H
	CALL	$BDOS
;
	RET
;
;
;
;	Program termination
;
;
$HTERM:
	LD	IX,(HINPP)
	CALL	$FCLOS
	LD	IX,(HOUTP)
	CALL	$FCLOS		; close "output"
;
	JP	BOOT
;
;
;	Routine	$MVAIL  -  memory available between top of heap and stack
;
;	(Called from the Pascal-coded function memavail, in H7LIB.)
;
;	Entry	no arguments
;
;	Exit	HL,BC = result (in bytes) (always positive)
;
$MVAIL:
	POP	IY		; link
	LD	HL,($STKLM)	; complement of ($HPLM + GAP)
	ADD	HL,SP
	LD	C,L
	LD	B,H
	LD	HL,0		; 32-bit integer result
	JP	(IY)		; return
;
;
;
;	===================
;
;
;	$BDOS  -  preserve IX and IY through BDOS calls
;
$BDOS:
	PUSH	IX
	PUSH	IY
	CALL	BDOS
	POP	IY
	POP	IX
	RET
;
;
;
;
NOROOM:
	LD	A,'S'
	LD	C,0
;
	CALL	$HERR
;
;

;	Run-time errors
;
;	Subroutine to output char in E to console.
;
CHOUT:
	PUSH	BC		; preserve BC,HL
	PUSH	HL
	LD	C,2
	CALL	$BDOS
	POP	HL
	POP	BC
	RET
;
;
;	Subroutine to convert byte in A to
;	two hex digits and output to the
;	console.  (Uses A, B, C, E.)
;
CAHEX:
	LD	C,A
	LD	B,2
;
	RRA
	RRA
	RRA
	RRA
;
CAHXLP:
	AND	0FH
	ADD	A,30H		; digit 0
	CP	3AH
	JP	M,GT9
	ADD	A,7		; make A-F
;
GT9:
	LD	E,A
	CALL	CHOUT
	LD	A,C		; original
	DJNZ	CAHXLP
;
	RET
;
;
;	Errors within Pascal-coded library
;
$PERR:
	POP	HL		; return address
	POP	AF		; A := error no.
	LD	C,2
	PUSH	HL
	CALL	$HERR
	RET
;
;
;	$HERR	Run-time error handling routine.
;
;	Entry	A	Error code letter
;		C	Bit 0 = 1 if extra display
;			Bit 1 = 1 if optional restart
;		B,DE	Count & address of extra display (if present)
;		(SP+2)	Address to be included in message
;
;
$HERR:
	PUSH	AF
;
	RR	C
	JR	NC,EMOUT	; no extra display
	EX	DE,HL
;
CHLOOP:
	LD	E,(HL)		; char from message
	INC	HL
	CALL	CHOUT
	DJNZ	CHLOOP
;
;	Output error code
;
EMOUT:
	PUSH	BC
	LD	C,9
	LD	DE,ERRMES	; 'Error '
	CALL	$BDOS
;
	POP	BC
	POP	AF
	PUSH	BC
	LD	E,A		; code letter
	CALL	CHOUT
;
	LD	C,9
	LD	DE,ATADDR	; ' at address '
	CALL	$BDOS
;
;
;	Convert address to hex
;
	POP	BC
	POP	DE
	POP	HL		; address for display
	PUSH	HL
	PUSH	DE
	PUSH	BC
;
	LD	A,H
	CALL	CAHEX
	LD	A,L
	CALL	CAHEX
;
	LD	E,0DH		; c/r
	CALL	CHOUT
	LD	E,0AH		; l/f
	CALL	CHOUT
;
	CALL	$DPRST		; print line number stack
;
	POP	BC
	RR	C
	JP	NC,BOOT		; terminate program
;
	LD	DE,RESMES
;
PUTMES:
	LD	C,9H
	CALL	$BDOS
;
GETYN:
	LD	C,1
	CALL	$BDOS		; read console
	CP	'Y'
	JR	Z,RESUME
	CP	'y'
	JR	Z,RESUME
;
	CP	'N'
	JP	Z,$STOP
	CP	'n'
	JP	Z,$STOP
;
	LD	DE,BACKSP		; if not Y or N ..
	CP	20H			; erase from screen
	JR	NC,PUTMES
	JR	GETYN
;
;
RESUME:
	LD	E,0DH		; c/r
	CALL	CHOUT
	LD	E,0AH		; l/f
	CALL	CHOUT
;
	RET
;
;
ERRMES:	DB	0DH,0AH,'Error $'
ATADDR:	DB	' at address $'
RESMES:	DB	'Continue ? (Y/N) $'
BACKSP: DB	08,' ',08,'$'
;
;
;
	END

«eof»