Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/cancel.mac
There are 7 other files named cancel.mac in the archive. Click here to see a list.
; UPD ID= 2675 on 3/24/80 at 1:55 PM by NIXON
TITLE CANCEL FOR LIBOL V12C
SUBTTL CANCEL SUBPROGRAMS FROM CORE D. TOLMAN/DMN
SEARCH COPYRT
SALL
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 1985
;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.
SEARCH LBLPRM ;LIBOL PARAMETER FILE
%%LBLP==:%%LBLP
;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.
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
CANCL.:
PUSH PP,0 ;SAVE REGS THAT OVERLAY HANDLER WILL DESTROY
PUSH PP,1
IFN ANS74,<
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
CAIN T1,(JSP 1,) ;IS IT A JSP?
JRST CANOVL ;YES, GO CANCEL THE OVERLAY
;HERE TO REPLACE CURRENT SUBROUTINE BY ORIGINAL FROM EXE FILE
CANEXE: 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
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 CANCEL 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
IFN ANS74,<
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 CANEXE] ;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 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:
POP PP,1 ; AND RESTORE
POP PP,0
POPJ PP, ;RETURN
; REMOVL ARGUMENT BLOCK
-1,,0 ;ARGUMENT COUNT
REMARG: 100,,LNKNO.##
SUBTTL CALL SUBROUTINE AT RUN-TIME D.M.NIXON
IFN ANS74,<
ENTRY S.CALL
;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