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