Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/cancel.mac
There are 7 other files named cancel.mac in the archive. Click here to see a list.
; UPD ID= 1162 on 5/24/83 at 10:48 AM by NIXON                          
TITLE	CANCEL FOR LIBOL V13
SUBTTL	CANCEL SUBPROGRAMS FROM CORE		D. TOLMAN/DMN

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


SEARCH	LBLPRM		;LIBOL PARAMETER FILE

	%%LBLP==:%%LBLP

IFN TOPS20,<SEARCH	MONSYM,MACSYM>

;V10***********************************
;NAME	DATE		COMMENTS
;DBT	4/7/75		SAVE 0 AND 1 FOR OVERLAY HANDLER CALLS
;***************************************


;CALLING SEQUENCE:
;	MOVEI	16,ROUTINE		;GET ROUTINE NAME
;	PUSHJ	17,CANCL.
;	RETURN
;OR
;	MOVE	16,[ROUTINE]		;GET ROUTINE NAME IN SIXBIT
;	PUSHJ	17,CANCL.
;	RETURN
;

;IF THE ROUTINE IS IN AN OVERLAY ONE WILL FIND A LINK OVERLAY BLOCK
; AT THE ADDRESS REFERENCED IN THE PUSHJ. THE BLOCK IS OF THE FORM:
;
;	JSP	1,.OVRLA
;	0	ADDRESS
;	LINK#	ADDRESS
;	0
;
;THIS ROUTINE CHECKS FOR AN OCCURRANCE OF THIS BLOCK AND IF FOUND
; WILL PICK UP THE LINK# AND CALL REMOV. TO CANCEL THE SUBROUTINE.
; IF THE BLOCK IS NOT THERE A WARNING MESSAGE WILL BE ISSUED

;DUE TO THE IMPLEMENTATION OF OVERLAYS - ALL HIGHER LEVEL LINKS ARE IN
;CORE - IF A BLOCK IS FOUND THE CANCEL IS LEGITIMATE , OTHERWISE NOT.
HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file
SALL


ENTRY	CANCL.,S.CALL,INITL.
EXTERN	FUNCT.,FUN.A0,FUN.ST,FUN.A1,FUN.A2,FUN.A3,SAVAC.,RSTAC.

;ACC DEFINITIONS

AC13==13
AC14==14
AC15==15
AC16==16

;FUNCT. ARGS
F.GCH==4		;GET CHAN.
F.RCH==5		;RETURN CHAN.
F.GOT==6		;GET CORE
F.ROT==7		;RETURN CORE
F.IFS==11		;DEV:FILE.EXT[PPN]

;SUBROUTINE ARG TYPES
A.SPI==2		;INTEGER
A.S==17			;ASCII STRING

FIXNUM==22		;SIZE OF FIXED PART OF EACH SUBROUTINE

IFN TOPS20,<
DEFINE OUTSTR	(A)<
	HRROI	1,A
	PSOUT
>
CANCL.:	TLNE	PARM,-1		;SIXBIT NAME?
	JRST	CANSIX		;YES

	; DO WE HAVE AN OVERLAY BLOCK?
	;
	; THE METHOD IS NOT VERY "NICE" BUT IS THE ONLY ONE WE COULD
	; THINK OF.

	HLRZ	T1,(PARM)	;GET LEFT HALF OF FIRST WORD
	CAIE	T1,(JSP	1,)	;IS IT A JSP?
	JRST	INITL.		;NO, GO INITIALIZE THE SUBROUTINE DATA

;HERE TO CANCEL A LINK OVERLAY
CANOVL:	HRRZ	T1,(PARM)	;MAYBE
	MOVE	T2,-1(T1)	;WHAT ROUTINE IS REFERENCED?
	CAMN	T2,[SIXBIT '.OVRLA']
	JRST	GETLNK		;ITS AN OVERLAY - GET LINK#
	CAME	T2,[SIXBIT '.OVRLU']	;MAYBE ITS LINKS "NOT LOADED" ROUTINE?
	JRST	NOTOVL		;NO - NOT OVERLAY
	PUSHJ	PP,(T1)		;ISSUE NOT LOADED LINK WARNING
	JRST	RETURN		;RETURN

NOTOVL:
	;NOT AN OVERLAY

	OUTSTR	[ASCIZ	'%Attempt to CANCEL subroutine which is not in an overlay,
	or is in the current or a higher level link
']
	JRST	RETURN		;RETURN

GETLNK:
	;CANCEL THE OVERLAY

	HLRZ	T1,2(PARM)	;GET LINK#
	MOVEM	T1,LNKNO.##	;SAVE IT IN REMOVL ARG BLOCK
	MOVEI	PARM,REMARG
REMLNK:	PUSHJ	PP,@TRAC4.##	;GO TELL COBDDT IT'S GOING AWAY.
	PUSHJ	PP,@%REMOV##	;CANCEL IT - %REMOV IS FILLED IN BY
				;COBST WITH THE ADDRESS OF REMOVL 
				;THERE IS A DUMMY REMOVL IN LIBOL.REL 
				;WHICH WILL BE LOADED IF THERE ARE NO
				;OVERLAYS

RETURN:	POPJ	PP,		;RETURN

; REMOVL ARGUMENT BLOCK
	-1,,0		;ARGUMENT COUNT
REMARG:	100,,LNKNO.##
;Here when called with a sixbit name

CANSIX:	MOVE	T1,%F.PTR##	;ADDRESS OF MAIN ENTRY POINT
	SUBI	T1,3		;POINT TO LINK TO NEXT
	CAMN	PARM,2(T1)	;NAME MATCH?
	JRST	[MOVEI	PARM,3(T1)	;YES, GET ADDRESS
		JRST	INITL.]		;AND CONTINUE
	HRRZ	T1,(T1)		;NO, GET NEXT
	JUMPN	T1,.-3		;LOOP
				;NOT IN CORE TRY OVRLAY FILE
	MOVEM	PARM,LNKNO.	;SAVE NAME
	MOVEI	PARM,CALARG	;POINT TO IT
	JRST	REMLNK		;JOIN COMMON CODE
;HERE TO REPLACE CURRENT SUBROUTINE BY ORIGINAL FROM EXE FILE

;CALLING SEQUENCE:
;	MOVEI	16,ROUTINE		;SUBROUTINE ADDRESS
;	PUSHJ	17,INITL.##		;ROUTINE TO REINITIALIZE DATA
;	RETURN

INITL.:	PUSHJ	PP,SAVAC.	;GET SOME ACCS TO PLAY WITH
	HRRZ	AC13,1(PARM)	;GET PTR. TO %FILES FOR THIS SUBROUTINE
	HRRZ	AC14,3(AC13)	;GET HIGHEST LOC+1
	HLRZ	AC13,3(AC13)	;GET FIRST LOC
	ADDI	AC13,FIXNUM	;BYPASS FIXED PART
	SUBI	AC14,1		;LAST WORD TO RESTORE
IFN TOPS20,<
	SKIPN	2,EXJFN.##	;CAN WE GET STRING OR JFN?
	JRST	CANEXE		;NO, TRY OLD CODE
	JUMPG	2,GOTJFN	;JUMP IF NOT THE FIRST TIME
	MOVX	1,GJ%OLD+GJ%SHT
	GTJFN%
	  ERJMP	CANEXE		;TRY OLDWAY
	HRRZM	1,EXJFN.	;STORE JFN FOR FUTURE USE

;If we are not in non-zero section or if section 0 and section 1
;are not already mapped together, map them together.

	XMOVEI	1,.		;TO SEE WHAT SECTION WE ARE IN
	TLNE	1,-1		;SKIP IS SECTION 0
	JRST	INITL1		;ITS NOT
	MOVE	1,[.FHSLF,,1]	;SEE IF ALREADY MAPPED
	RSMAP%
	  ERJMP	CANEXE		;ERROR
	AOJN	1,INITL1	;ALREADY MAPPED
	MOVSI	1,.FHSLF	;THIS FORK IN SECTION 0
	MOVE	2,[.FHSLF,,1]	;...	      SECTION 1
	MOVX	3,SM%RD!SM%WR!SM%EX!SM%IND+1
	SMAP%			;MAP THE SECTIONS TOGETHER
	  ERJMP	CANEXE		;ERROR
INITL1:

;Now loop through the sections looking for the first free one starting at section 2

	MOVEI	T1,1		;WE DON'T USE 1 SINCE ITS MAPPED TO 0
INITL2:	AOS	1,T1		;TRY NEXT SECTION
	CAILE	1,37		;MAKE SURE SOME STILL LEFT
	JRST	CANEXE		;TO BAD, TRY OLDWAY
	HRLI	1,.FHSLF
	RSMAP%
	  ERJMP	CANEXE		;ERROR, TRY OLD WAY
	AOJN	1,INITL2	;TRY NEXT IF NOT FREE

;Now create the section and map the .EXE file into it

	SETZ	1,		;JUST CREATE SECTION
	HRLI	2,.FHSLF
	HRR	2,T1
	MOVX	3,PM%RD!1
	SMAP%			;CREATE IT
	  ERJMP	CANEXE		;ERROR
	HRLM	T1,EXJFN.	;SAVE SECTION #

;Set up for GET JSYS

	HRRZ	1,EXJFN.
	HRLI	1,.FHSLF
	TXO	1,GT%ARG	;USE ARG BLOCK
	MOVEI	2,T1		;ARG BLOCK FOR GET JSYS
	MOVX	T1,GT%LOW!GT%BAS
	SETZB	T2,T3
	HLRZ	T4,EXJFN.	;BASE SECTION

;Now jump into section 1 and get the .EXE file into the new section

	XMOVEI	AC12,.		;GET CURRENT ADDRESS
	TLNN	AC12,-1		;ALREADY IN A NON-ZERO SECTION?
	XJRSTF	[0
		1,,.+1]		;NO, GET THERE

	GET%
	  ERJMP	CANEXE
	TLNN	AC12,-1		;DO WE NEED TO RETURN TO SECTION 0?
	XJRSTF	[0
		.+1]		;YES

;Here when .EXE file is mapped into a non-zero section
;all we have to do is XBLT the impure data.

GOTJFN:	MOVE	AC12,AC14	;SEE HOW MANY WORDS TO MOVE
	SUB	AC12,AC13
	HLL	AC13,EXJFN.	;GET SECTION #
	HRRZ	AC14,AC13	;COPY TO SAME LOCATION
	XHLLI	AC14,.		;GET CURRENT SECTION #
	TLNE	AC14,-1		;IN SECTION ZERO?
	JRST	NOTZRO		;NO, ALL OK
	DMOVE	T1,[EXTEND AC12,1
		XJRSTF	2]
	MOVSI	1,(XBLT)
	SETZ	2,
	XMOVEI	3,INIDON
	XJRSTF	[0
		1,,T1]		;JUMP TO SECTION 1
NOTZRO:	EXTEND	AC12,[XBLT]	;RE-INIT DATA
INIDON:	PUSHJ	PP,RSTAC.
	POPJ	PP,		;RETURN TO CALLER

;All errors that go to CANEXE should come here when the code is native.

ININOT:	HRROI	1,[ASCIZ	/%Failed to initialize subprogram from EXE file
/]
	PSOUT%
	SETZM	EXJFN.		;SO WE DON'T TRY IT AGAIN
	JRST	INIDON
>
;This code is here for TOPS-10 systems and TOPS-20 2020 systems.
;However if the -20 code is ever nativized this code cannot be used.

IFE TOPS20&0,<

CANEXE:
IFN TOPS20,<
	SETZM	EXJFN.		;SO WE DON'T TRY MULTI-SECTION CODE
>
	MOVEI	T1,F.GCH	;GET A CHANNEL
	MOVEM	T1,FUN.A0
	MOVEI	AC16,FUNARG
	PUSHJ	PP,FUNCT.	;GET IT
	SKIPE	FUN.ST
	JRST	CANNOT
	MOVE	AC15,FUN.A1	;STORE CHAN. # IN SAFE ACC
	LSH	AC15,^D18+5	;PUT IN ACC FIELD
	MOVEI	T1,F.IFS
	MOVEM	T1,FUN.A0	;GET INITIAL FILE SPEC
	MOVEI	AC16,FUNARG
	PUSHJ	PP,FUNCT.	;
	SKIPE	FUN.ST
	JRST	CANNOT		;FAIL
	MOVE	T1,[OPEN T2]
	IOR	T1,AC15		;PUT IN CHAN. NO.
	MOVEI	T2,16
	MOVE	T3,FUN.A1	;GET DEVICE
	SETZ	T4,		;NO BUFFERS
	XCT	T1		;DO OPEN
	  JRST	CANNOT		;FAILED
	TLC	T1,(<OPEN>^!<LOOKUP>)
	MOVE	T2,FUN.A2	;FILE NAME
	MOVSI	T3,'EXE'	;EXT MUST BE EXE
	MOVE	T5,FUN.A3	;[PPN]
	XCT	T1		;LOOKUP FILE
	  JRST	CANNOT		;FAILED
	MOVEI	T1,F.GOT
	MOVEM	T1,FUN.A0
	MOVEI	T1,1000		;NEED 1 PAGE FOR DIRECTORY
	MOVEM	T1,FUN.A2
	MOVEI	AC16,FUNARG
	PUSHJ	PP,FUNCT.
	SKIPE	FUN.ST
	JRST	CANNOT		;FAILED
	MOVE	T1,[IN	T2]
	IOR	T1,AC15
	MOVSI	T2,-1000
	HRR	T2,FUN.A1	;ADDRESS
	SUBI	T2,1		;IOWD
	SETZ	T3,
	XCT	T1		;READ IN DIRECTORY
	  SKIPA	T5,FUN.A1	;OK, GET START OF BUFFER
	JRST	CANNOT		;FAILED
	HLRZ	T1,(T5)		;GET TYPE
	CAIE	T1,1776		;BETTER BE DIRECTORY
	JRST	CANNOT		;NO, GIVE UP
	HRRZ	T1,(T5)		;GET COUNT
	MOVN	T1,T1
	HRL	T5,T1		;FORM AOBJN WORD
	AOBJP	T5,.+1		;BYPASS COUNT
	MOVE	T4,AC13		;GET LOWER ADDRESS
	ANDCMI	T4,777		;ROUND DOWN TO START OF PAGE
CANLUP:	HRRZ	T1,1(T5)	;GET CORE PAGE
	LSH	T1,^D10		;WORDS
	LDB	T3,[POINT 9,1(T5),8]	;GET REPEAT COUNT
	MOVNI	T3,1(T3)	;ACCOUNT FOR FIRST PAGE + REPEATED ONES
	HRLZ	T3,T3		;INNER AOBJN PTR
CANLP1:	CAIN	T1,(T4)		;FOUND RIGHT CORE PAGE?
	JRST	CANFND		;YES
	ADDI	T1,1000
	AOBJN	T3,CANLP1	;LOOP ON REPEAT COUNT
	AOBJN	T5,.+1
	AOBJN	T5,CANLUP	;TRY AGAIN
				;FAILED

CANNOT:	OUTSTR	[ASCIZ	/%Failed to initialize subprogram from EXE file
/]
	JRST	CANDON

CANFND:	HRRZ	T1,(T5)		;GET FILE PAGE
	ADDI	T1,(T3)		;PLUS REPEAT COUNT
	LSH	T1,2		;GET FILE BLOCK
	ADDI	T1,1		;SO PAGE 0 STARTS AT BLOCK 1
	HRLI	T1,(USETI)
	IOR	T1,AC15		;FORM USETI
	XCT	T1		;SET ON FIRST BLOCK OF PAGE
	MOVE	T1,[IN T2]
	IOR	T1,AC15
	SETZ	T3,
	XCT	T1
	  SKIPA	T4,AC13		;OK
	JRST	CANNOT		;FAILED TO READ IN FIRST 1000 WORDS
	ANDI	T4,777		;OFFSET FROM PAGE BOUNDARY
	ADDI	T4,1(T2)	;FROM
	HRLZ	T4,T4
	HRR	T4,AC13		;TO
	MOVE	T5,AC13		;ASSUME NOT BOTH IN SAME PAGE
	XOR	AC13,AC14	;SEE IF BOTH IN SAME PAGE
	TRNN	AC13,777000	;ARE THEY
	SKIPA	T5,AC14		;YES, AC14 IS REAL END
	TRO	T5,777		;NO, COPY UP TO PAGE BOUNDARY
	BLT	T4,(T5)
	TRNN	AC13,777000	;ARE WE THROUGH
	JRST	CANDON		;YES
	XOR	AC13,AC14	;NO, PUT AC13 BACK
	IORI	AC13,777	;ROUND UP TO PAGE BOUNDARY
	HRR	T2,AC13		;NEXT PAGE -1
	SUBI	AC13,-1(AC14)	;- LENGTH
	HRL	T2,AC13
	XCT	T1		;READ REST INTO PLACE
	  CAIA
	JRST	CANNOT
CANDON:	MOVEI	AC16,FUNARG
	AOS	T1,FUN.A0	;SEE IF LAST CALL WAS F.GOT
	CAIN	T1,F.ROT	;WILL BE IF F.ROT=F.GOT+1
	PUSHJ	PP,FUNCT.	;YES, GIVE BACK CORE
	MOVEI	T1,F.RCH
	MOVEM	T1,FUN.A0	;GIVE BACK CHAN.
	LSH	AC15,-<^D18+5>
	MOVEM	AC15,FUN.A1
	PUSHJ	PP,FUNCT.
	PUSHJ	PP,RSTAC.
	JRST	RETURN


	-6,,0
FUNARG:	A.SPI,FUN.A0
	A.S,[ASCIZ /CBL/]
	A.SPI,FUN.ST
	A.SPI,FUN.A1
	A.SPI,FUN.A2
	A.SPI,FUN.A3

>
SUBTTL	CALL SUBROUTINE AT RUN-TIME	D.M.NIXON

;CALLING SEQUENCE:
;	MOVEI	16,%LIT+N		;ARGS TO SUBROUTINE
;	PUSHJ	17,S.CALL##		;ROUTINE TO DO RUN-TIME LINKAGE
;	SIXBIT	/NAME/			;SUBROUTINE WE WANT
;	RETURN

S.CALL:	MOVE	T1,%F.PTR##	;ADDRESS OF MAIN ENTRY POINT
	SUBI	T1,3		;POINT TO LINK TO NEXT
	MOVE	T2,@(PP)	;DESIRED SUBROUTINE NAME
	MOVE	T2,(T2)		;...
	AOS	(PP)		;SKIP OVER NAME

	CAMN	T2,2(T1)	;NAME MATCH?
	JRST	3(T1)		;YES, GO TO IT
	HRRZ	T1,(T1)		;NO, GET NEXT
	JUMPN	T1,.-3		;LOOP

;NOT IN CORE TRY OVERLAY HANDLER
	PUSH	PP,0		;SAVE ACCS DESTROYED BY OVERLAY HANDLER
	PUSH	PP,1
	MOVEM	T2,LNKNO.	;SAVE SIXBIT NAME
	PUSH	PP,PARM		;SAVE ORIGINAL ARGS
	MOVEI	PARM,CALARG	;POINT TO OVERLAY ARGS
	PUSHJ	PP,@%ENTOV##	;CALL OVERLAY HANDLER
	POP	PP,PARM		;ORIGINAL ARGS
	POP	PP,1
	POP	PP,0
	SKIPE	LNKNO.		;ROUTINE EXIST?
	JRST	@LNKNO.		;YES, GO TO IT
	OUTSTR	[ASCIZ	/%Can not find overlay entry point
/]
	POPJ	PP,		;NO, RETURN TO CALLER

	-1,,0
CALARG:	5,LNKNO.		;SIGNAL SIXBIT WORD


	END