Google
 

Trailing-Edge - PDP-10 Archives - bb-r775c-bm_tops20_ks_upd_3 - sources/edtcal.mac
There are 11 other files named edtcal.mac in the archive. Click here to see a list.
	TITLE	EDTCAL

; IDENT 1-001

;****************************************************************************
;*									    *
;*  COPYRIGHT (C) 1978, 1985                                                *
;*  BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.			    *
;*  ALL RIGHTS RESERVED.                                                    *
;* 									    *
;*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED  *
;*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE  *
;*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER  *
;*  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY  *
;*  OTHER PERSON.  TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY     *
;*  TRANSFERRED.							    *
;* 									    *
;*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE  *
;*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT  *
;*  CORPORATION.							    *
;* 									    *
;*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS  *
;*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
;*									    *
;****************************************************************************

;
;FACILITY:	EDT-20 V1
;
;AUTHOR:	C. GILL,  DEC (LEEDS),  8-Nov-1983

	SALL
	SEARCH	MACSYM,MONSYM

;AC's

	A==1
	B==2
	C==3
	D==4
	ARG==16
	P==17

;Character definitions

	TAB==11
	LF==12
	CR==15
	SPACE==40

;+
;Local storage:
;-

FSPACE:	0			;Spacing flag
FORK:	0			;Process handle for subfork
FRKACS:	BLOCK	20		;Subfork AC's returned
STRING:	ASCII	/EDIT /		;Area to build string
	BLOCK	24

;+
;ABSTRACT:
;
;  This subroutine accepts a COBOL or FORTRAN style argument block pointed
;  to by AC16. The first argument is either a byte pointer to, or the address
;  of, the command string to be passed to EDT. This string is assumed to 
;  be on a word boundary and be zero terminated. (Level-1 item in COBOL).
;  EDTCAL assumes that the string ends in a <CR><LF> pair.
;
;  The second argument is the address of the return status. This will be
;  zero if there are no errors, or the TOPS-20 error code if anything goes
;  wrong.
;
;  Once a fork has been created, it will only be destroyed if an error occurs
;  or if this routine is called with a no arguments.
;-

	PAGE
	SUBTTL	ENTRY POINT

EDTCAL::
	PUSH	P,A			;Preserve some AC's
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	HLRE	A,-1(ARG)		;Get argument count
	JUMPE	A,EDTKIL		;KILL subfork
	MOVNS	A
	CAIE	A,2			;Must be two arguments
	 JRST	EDTRET			;Just return if not
	SKIPE	FORK			;If we have a fork
	 JRST	EDTC.1			; Then skip the creation

	MOVX	A,CR%CAP
	CFORK%				;Create a fork
	 ERJMP	EDTE.1			; Failed
	MOVEM	A,FORK			;Save handle as a flag
	MOVX	A,GJ%OLD!GJ%SHT
	MOVE	B,[POINT 7,[ASCIZ /SYS:EDT.EXE/]]
	GTJFN%				;Get a jfn for EDT
	 ERJMP	EDTE.2
	HRL	A,FORK
	GET%				;Get the whole file (map later)
	 ERJMP	EDTE.2

EDTC.1:

	MOVEI	A,.PRIOU
	CFIBF%				;Clear the input buffer for TTY:
	LDB	A,[POINT 4,(ARG),12]	;Get argument type
	CAIN	A,15			;COBOL string?
	 JRST	EDTC.2			; Yes
	SETZ	B,			;No - set zero length
	MOVEI	A,@(ARG)
	HRLI	A,(POINT 7,0)		;Get a pointer to the string
	JRST	EDTC.3

EDTC.2:				;Get COBOL string

	MOVEI	B,@(ARG)
	MOVE	A,0(B)			;Get pointer
	HRRZ	B,1(B)			;And length

EDTC.3:

	MOVE	D,[POINT 7,STRING+1]
	SETZM	FSPACE			;Clear a flag

EDTC.4:

	ILDB	C,A			;Get a character
	CAIE	C,CR			;If <CR>
	 SKIPN	C			;Or <NULL>
	  JRST	EDTC.7
	CAIN	C,LF			;Or <LF>
	 JRST	EDTC.7			; Then done with copy
	CAIE	C,SPACE			;Is it a space
	 CAIN	C,TAB			; Or a tab?
	  CAIA
	   JRST	EDTC.5			;  No
	MOVEI	C,SPACE			;Yes - save a space
	MOVEM	C,FSPACE
	SOJN	B,EDTC.4
	JRST	EDTC.7

EDTC.5:

	SKIPN	FSPACE			;Is space flag set?
	 JRST	EDTC.6			; No
	EXCH	C,FSPACE		;Yes - get the space
	IDPB	C,D			;And save it
	MOVE	C,FSPACE		;Now put in the real character

EDTC.6:

	IDPB	C,D
	SETZM	FSPACE			;Clear the flag
	SOJN	B,EDTC.4		;Loop more

EDTC.7:

	MOVEI	C,CR			;Insert <CR><LF><NULL>
	IDPB	C,D
	MOVEI	C,LF
	IDPB	C,D
	SETZ	C,
	IDPB	C,D

	MOVE	A,[POINT 7,STRING]	;Point to the string
	RSCAN%				;And put it in the rescan buffer
	 ERJMP	EDTE.2
	HRRZ	A,FORK
	SETZ	B,
	SFRKV%				;Start EDT according to entry vector
	WFORK%				;Wait for it
	MOVE	A,FORK
	RFSTS%				;Read the fork status
	HLRZ	B,A
	CAIN	B,.RFFPT		;If forced termination
	 JRST	EDTE.3			; Then report it
	MOVE	A,FORK			;Get fork handle
	MOVEI	B,FRKACS
	RFACS%				;Read the AC's
	MOVE	A,FRKACS+A		;Get the status return
	MOVEM	A,@1(ARG)		;And return the status
	JRST	EDTRET

	PAGE
	SUBTTL	ERRORS AND MISCELLANEOUS

EDTE.2:				;Can't create fork
	MOVEM	A,@1(ARG)		;Store error code
	HRRZ	A,FORK
	KFORK%				;Kill the EDT fork
	SETZM	FORK			;No fork now
	JRST	EDTRET

EDTE.3:				;Forced termination
	HRRZS	A			;Interrupt channel
	ADDI	A,^D100			;Offset it

EDTE.1:
	MOVEM	A,@1(ARG)		;Store error code
	JRST	EDTRET

EDTKIL:
	SKIPE	A,FORK			;Kill the EDT fork if there
	 KFORK%
	SETZM	FORK

EDTRET:
	POP	P,D			;Restore AC's
	POP	P,C
	POP	P,B
	POP	P,A
	RET

	END