DataMuseum.dk

top - download

    Length: 2432 (0x980)
    Types: TextFile
    Names: »ENTEXT.SRC«

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »ENTEXT.SRC« 

TextFile

;SUBROUTINES TO ENTER AND EXIT A PROC/FCT
;
	NAME ENTEXT
	ENTRY ENTRSC,ENTER,EXITF
	EXT STKERR,CLSOT,fsub,flterr,MXOUT
	include deflt.src
;
DSUB:	MACRO	Q,SIZE
	IF	0!SIZE&8000H	;;CHECK FOR FLOATING POINT SUBTRACTION
	CALL	FSUB
	IF	F		;;CHECK FOR ERROR IF REQUIRED
	JC	FLTERR
	ENDIF
	ELSE			;;SUBTRACT Q OR DE FROM HL
	XRA	A		;;CLEAR CARRY
	DSBC	Q D		;;SUBTRACT IT
	ENDIF
	ENDMAC			;;DONE
;
;
ENTRSC:	INR	A		;INDICATE STACK CHECKING
ENTER:	XTIX			;SAVE OLD DA POINTER
	LXI	H,0		;CLEAR OUT NEW DA
	PUSH	H
	PUSH	B		;SAVE LEVEL NUMBER
	DAD	S		;SP -> HL
	PUSH	H		;THIS VALUE IS NEW DA POINTER AND
	XTIX	
	DAD	D		;SUBTRACT ROOM FOR VARIABLES
	POP	D		;GET RETURN ADDRESS
	SPHL			;NEW SP
	PUSH	D		;RETURN ADDR -> TOP OF STACK
	ORA	A		;DO STACK CHECKING?
	RZ			;NO, JUST RETURN
	XRA	A		;CLEAR ACCUMULATOR
	EXX
	MOV	B,A		;CLEAR STATEMENT REGISTER
	MOV	C,A
	PUSH	H		;MOVE TOP OF THE HEAP
	EXX
	LXI	D,MARGIN	;GET SAFETY MARGIN
	DSUB	D		;SUBTRACT SAFETY MARGIN
	POP	D		;GET TOP OF HEAP
	DSUB	D		;CHECK FOR SP >= TOH+MARGIN
	JC	STKERR		;...STACK OVERFLOW ERROR
	RET			;ALL DONE
;
;
;
EXITF:	PUSH	IX
	POP	D		;DE <- IX
	DAD	D
;
; IN ORDER TO CLOSE OUTPUT FILES CORRECTLY JUST
; CLOSE ALL FILES WHOSE BUFFER ADDRESS IS LESS THAN
; THE ADDRESS IN THE HL REGISTER PAIR
; B, C, D, E, H, L MAY BE CHANGED PLEASE LEAVE THE
; OTHER REGISTERS INTACT ( THE ACCUMULATOR HAS A ZERO )
;
	PUSH	Y		;SAVE Y
	INX	Y
	LXI	B,MXOUT		;B GETS MAX. NUMBER OF OUTPUT FILES
	XCHG			;NEW STACK POINTER IN DE
SFLT:	MOV	H,1(Y)		;GET POSSIBLE BUFFER ADDRESS
	MOV	L,0(Y)
	MOV	A,H
	ORA	L		;CHECK FOR A ZERO
	JRZ	FGT		;YES, DON'T TRY TO CLOSE IT
	PUSH	H
	DSBC	D		;SEE IF FILE IS BELOW THE STACK
	POP	H
	JRNC	FGT		;NO, DON'T CLOSE IT
	INX	H		;POINT TO DOS BUFFER
	INX	H
	INX	H
	CALL	CLSOT		;CLOSE THE FILE
	XRA	A
	MOV	0(Y),A		;INDICATE THAT THIS SLOT IS EMPTY
	MOV	1(Y),A
FGT:	INX	Y
	INX	Y
	DJNZ	SFLT
	XRA	A		;ZERO A
	POP	Y		;RESTORE Y
	SPIX			;NEW SP
	POP	B		;SKIP LEVEL NUMBER
	XCHG			;RESTORE HL (NEW STACK POINTER)
	POP	D		;GET RETURN VALUE
	POP	X		;OLD DA POINTER
	POP	B		;GET RETURN ADDRESS
	SPHL			;SET NEW STACK POINTER
	MOV	H,B		;RETURN ADDRESS -> HL
	MOV	L,C
	CMP	E		;SET CARRY IF NECESSARY
	EXX			;CLEAR BC AS STATEMENT TRACE
	MOV	B,A
	MOV	C,A
	EXX
	PCHL			;RETURN
«eof»