Trailing-Edge
-
PDP-10 Archives
-
BB-R775C-BM
-
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