DataMuseum.dk

top - download

    Length: 2176 (0x880)
    Types: TextFile
    Names: »REWRIT.SRC«

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

TextFile

;ROUTINE TO REWRITE AN OUTPUT FILE
;
	NAME REWRIT
	ENTRY REWRITE,L123,ERRTMF
	EXT CLSOT,DELETE,OPNOT,MOVNAM,SCAN,PERROR
	INCLUDE DEFLT.SRC
;
;SYSTEM FILE BUFFER STRUCTURE
;FIRST BYTE IS FLAGS BYTE.BIT 0-EOLN,1-EOF,2-WRITTEN,3-PREVIOUS
;OPERATION A WRITE,4-RANDOMLY ACCESSED FILE.
;SECOND IS THE READ AHEAD BYTE FOR INPUT FILES

;REWRITE OPENS A FILE TO BE WRITTEN TO BY
;THE USER UNDER THE NAME X

L123:
REWRITE:POP	D	;RETURN ADDRESS
	INX	H
	INX	H
	INX	H
;MOVE THE NAME INTO THE BUFFER
	CALL	MOVNAM
	JRC	BADWRT	;BAD FILENAME
;LST: OR CON: FILES ARE NOT COUNTED AGAINST THE MAX. NUMBER OF 
;OUTPUT FILES SO SKIP CHKLST, DELETE AND OPNOT CALLS
	DCX	H
	DCX	H
	DCX	H	;FBA
	BIT	6,M	;LST: FILE?
	JRNZ	SETFLG	;YES
	BIT	7,M	;CON: FILE?
	JRNZ	SETFLG	;YES
;FIND THE FILE BUFFER IN THE LIST OR ADD IT
	CALL	CHKLST
	INX	H
	INX	H
	INX	H	;FCB
	CALL	DELETE	;DELETE ANY DUPLICATES
	CALL	OPNOT	;REOPEN IT
	DCX	H
	DCX	H
	DCX	H
SETFLG:	BSET	0,M	;SET EOLN FLAG
	RES	1,M	;EOF FLAG USED FOR DISC WRITE ERROR
	BSET 	2,M	;SET WRITTEN FLAG
	RES	3,M	;RESET PREV WRITTEN FLAG
	RES	4,M	;RANDOMLY ACCESSED FLAG
	XRA	A
	XCHG
	PCHL

;CHKLST EITHER FINDS THE BUFFER ADDRESS IN THE LIST,
;ADDS IT TO THE LIST, OR PRINTS AN ERROR IF MORE THAN
;MAXOUT OUTPUT FILES ARE OPEN SIMULTANEOUSLY.
CHKLST:	PUSH	Y
	CALL	SCAN
	JRNC	NOTFND
	INX	H	;CLOSE FILE IF FOUND
	INX	H
	INX	H
	CALL	CLSOT
	DCX	H
	DCX	H
	DCX	H
	POP	Y	;BUFFER IN LIST
	RET

;BUFFER ISN'T IN THE LIST, CHECK FOR SPACE
NOTFND:	POP	Y
	PUSH	Y
	PUSH	H
	MOV	H,A
	MOV	L,A
	CALL	SCAN
	JRNC	ERRTMF	;ADDRESS OF FIRST FREE SPACE IN LIST IS IN BC
	POP	H	;GET BUFFER ADDRESS
	MOV	A,H	;PUT BUFFER ADDRESS INTO LIST
	STAX	B
	DCX	B
	MOV	A,L
	STAX	B
	POP	Y
	RET

;TOO MANY OUTPUT FILES OPEN SIMULTANEOUSLY
ERRTMF:	LXI	H,ERRMES
	JMP	PERROR
ERRMES:
	IF	NOT COMPILER	;compiler doesn't need this
	DB	'Too many open output file','s'+80H
	ENDIF

;BADWRT BAD FILENAME ON OUTPUT FILE
;FATAL ERROR
BADWRT:	LXI	H,BNAM
	JMP	PERROR
BNAM:
	IF 	NOT COMPILER	;compiler doesn't need this
	DB	'Bad output file nam','e'+80H
	ENDIF
«eof»