Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/cobst.mac
There are 14 other files named cobst.mac in the archive. Click here to see a list.
; UPD ID= 3513 on 5/5/81 at 8:59 AM by NIXON
TITLE CON012 FOR LIBOL
SUBTTL STARTUP CODE FOR NON-REENTRANT COBOL PROGRAMS. /ACK/DMN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1981 BY DIGITAL EQUIPMENT CORPORATION
COMMENT \
THIS ROUTINE IS CALLED BY ALL NON-REENTRANT COBOL PROGRAMS
BEFORE THEY DO ANYTHING ELSE. IT SELECTS THE APPROPRIATE OBJECT
TIME SYSTEM AND RETURNS.
IT ALSO SAVE ACCUMULATORS FROM RUN UUO FOR OVERLAYS AND SEGMENTATION.
THIS ROUTINE IS ALSO CALLED BY RERUN TO REPLACE RERUN WITH
THE APPROPRIATE LIBOL AND THEN TRANSFER CONTROL TO LIBOL.
\
;***** REVISION HISTORY *****
;
; DATE WHO COMMENTS
;
; 9-NOV-78 DMN [453] MOVE .JBHRL SETUP FROM CBLIO
;15-JAN-76 ACK CREATION
;*****
ENTRY CN.12
CN.12: ;ENTRY POINT TO LOAD NON-REENTRANT VERSION
INTERN COBST. ;ENTRY POINT THAT LIBOL USES (MUST NOT BE ENTRY)
SALL
SEARCH INTERM,COMUNI
IFN TOPS20,<SEARCH MONSYM,MACSYM>
IFE TOPS20,<SEARCH UUOSYM,MACTEN>
;ACCUMULATOR DEFINITIONS:
; T1-T4 DEFINITIONS MUST BE FOR AC 1-4 FOR TOPS20 JSYS ARGS
T1==1
T2==2
T3==3
T4==4
JAC==16
PP==17
COBST.: JRST MPRTNS ;MAIN PROGRAM ENTRY ADDRESS
; (VIA JSP JAC,COBST.)
JRST RRRTNS ;RERUN ENTRY ADDRESS (VIA
; JRST COBST.+1)
IFN TOPS20,<
POINT 7,SAVSTR ; COBST.+2
; POINTER TO STRING FOR SAVE JFN
>
MPRTNS:
IFE TOPS20,<
TLNE .SGDEV,700000 ;IF NOT GARBAGE IN 11
MOVEM .SGDEV,RN.DEV## ; SAVE RUN DEVICE
MOVEM .SGNAM,RN.NAM## ;SAVE RUN NAME
SKIPE .SGDEV ;IF THERE WAS A DEVICE
MOVEM .SGPPN,RN.PPN## ; SAVE THE PPN
>
MOVEM 17,SAVACS+17 ;SAVE THE AC'S.
HRRZI 17,SAVACS
BLT 17,SAVACS+16
IFN TOPS20,<
MOVE 1,[.FHSLF,,400] ;PURE PAGE IN THIS FORK
RPACS% ;READ ACCESSABILITY
ERJMP MPRTNH
JUMPN 2,MPRTNP ;OK
HRR 1,1 ;NO HIGH SEG TRY PAGE 1
RPACS%
ERJMP MPRTNH ;GIVE UP
MPRTNP: TXNE 2,PA%PRV ;PRIVATE?
JRST MPRTNH ;TOO BAD
RMAP% ;JFN FROM WHENCE WE CAME
ERJMP MPRTNH
HLRZ 2,1 ;JFN
MOVE 1,COBST.+2 ;WHERE TO STORE IT
MOVX 3,JS%DEV!JS%DIR!JS%NAM!JS%TYP!JS%GEN!JS%PAF
JFNS%
ERJMP MPRTNH
>
IFE TOPS20,<
JUMPE .SGDEV,MPRTNH ;USER DID A LOAD ONLY
HRROI T1,.GTRDV
GETTAB T1, ;GET DEVICE
JRST MPRTNH ;PRE 6.03
JUMPE T1,MPRTNH ;NOT IMPLEMENTED
MOVEM T1,RN.DEV ;SAVE ACTUAL DEVICE
HRROI T1,.GTRDI
GETTAB T1, ;GET DIRECTORY
JRST MPRTNH
MOVEM T1,RN.PPN ;SAVE ACTUAL PPN
HRROI T1,.GTRS0
GETTAB T1, ;GET SFD #1
JRST MPRTNH ;PRE 7.01
JUMPE T1,MPRTNH ;NO SFD
MOVEM T1,RN.PTH+.PTSFD ;SAVE SFD
MOVEI T1,RN.PTH ;GET POINTER
EXCH T1,RN.PPN ;SWAP WITH PPN
MOVEM T1,RN.PTH+.PTPPN ;SAVE PPN
HRROI T1,.GTRS1
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+1
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS2
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+2
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS3
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+3
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS4
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+4
SETZM RN.PTH+.PTMAX-1 ;TERMINATE WITH ZERO
>
MPRTNH:
IFE TOPS20,<
HRLZI T1,1 ;THROW AWAY THE HIGH SEGMENT.
CORE T1,
JFCL ;DON'T CARE IF IT FAILS.
HRRZI T1,OTSES ;GETSEG THE APPROPRIATE OTS.
GETSEG T1,
HALT MPRTNL ;WE CARE IF THIS FAILS.
>;END OF IFE TOPS20.
IFN TOPS20,<
MOVX T1,RF%LNG!.FHSLF ;LONG FORM FOR THIS PROCESS
MOVEI T2,RFSBLK ;ARG BLOCK
SETZM RFSBLK+.RFSFL ;MAKE SURE ITS CLEAR INCASE REL 3
RFSTS% ;GET STATUS
ERJMP RFSER ;ASSUME NOT EXECUTE-ONLY
IFGE RF%EXO,<PRINTX ?ERROR - RF%EXO is not the sign bit> ;INCASE IT CHANGES
SKIPGE RFSBLK+.RFSFL ;RF%EXO IS SIGN BIT
SKIPA T1,[GJ%OLD!GJ%SHT!GJ%PHY] ;PHYSICAL ONLY IF EXECUTE-ONLY
RFSER: MOVX T1,GJ%OLD!GJ%SHT ;DO A SHORT GTJFN.
HRROI T2,OTSES
GTJFN%
JRST MPRTNL ;COMPLAIN IF WE CAN'T FIND THE OTS.
HRLI T1,.FHSLF ;THIS PROCESS
TRO T1,GT%ADR ;CHECK ADDRESS LIMITS
MOVE T2,[400,,677] ;ALL OF HIGH SEGMENT
GET% ;GET THE OTS.
MOVE T1,[677777-HI.ORG,,677777] ;[543] GET FAKE LENGTH,,HIGHEST LOC
SKIPN .JBHRL## ;[543] NOT SETUP IF /U
MOVEM T1,.JBHRL ;[543] SO JUST FAKE IT FOR OVERLAYS
>;END OF IFN TOPS20.
HRLZI 17,SAVACS ;RESTORE THE AC'S.
BLT 17,17
JRST (JAC) ;RETURN.
MPRTNL:
IFE TOPS20,<
IFN ANS68,<
OUTSTR [ASCIZ /
?GETSEG of SYS:LIBO12.EXE failed.
/]
>
IFN ANS74,<
OUTSTR [ASCIZ /
?GETSEG of SYS:C74O12.EXE failed.
/]
>
HALT MPRTNH
>;END OF IFE TOPS20.
IFN TOPS20,<
HRROI T1,[ASCIZ /
?/]
PSOUT%
HRROI T1,[ASCIZ /Execute-only /]
SKIPGE RFSBLK+.RFSFL ;EXECUTE-ONLY?
PSOUT% ;YES
HRROI T1,[ASCIZ /GTJFN failed for /]
PSOUT%
HRROI T1,OTSES
PSOUT%
HRROI T1,[ASCIZ /.
/]
PSOUT%
HALTF%
JRST MPRTNH ;IN CASE HE TRIES TO RESUME.
> ;END OF IFN TOPS20.
RRRTNS: JSP JAC, MPRTNS ;GO GET LIBOL.
; RESTORE THE AC'S THAT LIBOL HAD SAVED WHEN IT MADE THE CHECKPOINT FILE.
..I==0
REPEAT 17,<
POP PP, ..I
..I==..I+1>
POPJ PP, ;ANSWER LIBOL'S PUSHJ PP,RRDMP.
SUBTTL DATA.
SAVACS: BLOCK 20 ;PLACE TO SAVE THE AC'S.
IFN TOPS20,<
SAVSTR: BLOCK 20 ;PLACE TO SAVE DEV:<DIR>NAME OF SAVE FILE
RFSBLK: EXP .RFSFL+1 ;ARG BLOCK FOR LONG FORM RFSTS% JSYS
BLOCK .RFSFL ;SPACE FOR RETURNED ARGS
>
IFE TOPS20,<
RN.PTH: BLOCK .PTMAX ;FULL PATH SPECIFICATION OF SAVE FILE
>
OTSES: ;THE OTSES.
IFE TOPS20,<
SIXBIT /SYS/
IFN ANS68,<
SIXBIT /LIBO12/
>
IFN ANS74,<
SIXBIT /C74O12/
>
Z
Z
Z
Z
>;END OF IFE TOPS20.
IFN TOPS20,<
IFN ANS68,<
ASCIZ /SYS:LIBO12.EXE/
>
IFN ANS74,<
ASCIZ /SYS:C74O12.EXE/
>
>;END OF IFN TOPS20.
PRGEND
TITLE COR012
SUBTTL STARTUP CODE FOR REENTRANT COBOL PROGRAMS. /ACK/DMN
;COPYRIGHT 1976, 1981 DIGITAL EQUIPMENT CORP., MAYNARD MA.
COMMENT \
THIS ROUTINE IS CALLED BY ALL REENTRANT COBOL PROGRAMS
BEFORE THEY DO ANYTHING ELSE. CURRENTLY IT DOESN'T DO ANYTHING
BUT IT IS CONSISTANT WITH NON-REENTRANT PROGRAMS AND DOESN'T COST
ENOUGH TO WORRY ABOUT.
IT SAVE ACCUMULATORS FROM RUN UUO FOR OVERLAYS AND SEGMENTATION.
THE MAIN PURPOSE OF THIS ROUTINE IS TO REPLACE RERUN BY
THE COBOL PROGRAM'S HIGH SEGMENT WHEN RESTARTING FROM A RERUN
DUMP.
\
;***** REVISION HISTORY *****
;
; DATE WHO COMMENTS
;
;15-JAN-76 ACK CREATION
;*****
ENTRY CR.12
CR.12: ;ENTRY POINT TO LOAD EENTRANT VERSION
INTERN COBST. ;ENTRY POINT THAT LIBOL USES (MUST NOT BE ENTRY)
INTERN LIDSP. ;** INCASE RMS OR SOMEONE ELSE HAS MADE
; AN EXTERNAL REFERENCE TO THIS..
LIDSP.==0 ;DEFINE IT
SALL
SEARCH INTERM
IFN TOPS20,<SEARCH MONSYM,MACSYM>
IFE TOPS20,<SEARCH UUOSYM,MACTEN>
;ACCUMULATOR DEFINITIONS:
; T1-T4 DEFINITIONS MUST BE FOR AC 1-4 FOR TOPS20 JSYS ARGS
T1==1
T2==2
T3==3
T4==4
JAC==16
PP==17
COBST.: JRST MPRTNS ;MAIN PROGRAM ENTRY ADDRESS
; (VIA JSP JAC,COBST.)
JRST RRRTNS ;RERUN ENTRY ADDRESS (VIA
; JRST COBST.+1)
IFN TOPS20,<
POINT 7,SAVSTR ; COBST.+2
; POINTER TO STRING FOR SAVE JFN
>
;HERE TO SAVE INITIAL ACCS FOR OVERLAYS AND SEGMENTATION
MPRTNS: SETOM OVFLO.## ;[12B] IN V13, THIS WILL BE "SLRSW."
IFE TOPS20,<
TLNE .SGDEV,700000 ;IF NOT GARBAGE IN 11
MOVEM .SGDEV,RN.DEV## ; SAVE RUN DEVICE
MOVEM .SGNAM,RN.NAM## ;SAVE RUN NAME
JUMPE .SGDEV,(JAC) ;USER DID A LOAD ONLY
MOVEM .SGPPN,RN.PPN## ;IF THERE WAS A DEVICE SAVE THE PPN
>
MOVEM 17,SAVACS+17 ;SAVE THE AC'S.
HRRZI 17,SAVACS
BLT 17,SAVACS+16
IFN TOPS20,<
MOVE 1,[.FHSLF,,1] ;PURE PAGE IN THIS FORK
RPACS% ;READ ACCESSABILITY
ERJMP MPRTNH ;GIVE UP
TXNE 2,PA%PRV ;PRIVATE?
JRST MPRTNH ;TOO BAD
RMAP% ;JFN FROM WHENCE WE CAME
ERJMP MPRTNH
HLRZ 2,1 ;JFN
MOVE 1,COBST.+2 ;WHERE TO STORE IT
MOVX 3,JS%DEV!JS%DIR!JS%NAM!JS%TYP!JS%GEN!JS%PAF
JFNS%
ERJMP MPRTNH
>
IFE TOPS20,<
HRROI T1,.GTRDV
GETTAB T1, ;GET DEVICE
JRST MPRTNH ;PRE 6.03
JUMPE T1,MPRTNH ;NOT IMPLEMENTED
MOVEM T1,RN.DEV ;SAVE ACTUAL DEVICE
HRROI T1,.GTRDI
GETTAB T1, ;GET DIRECTORY
JRST MPRTNH
MOVEM T1,RN.PPN ;SAVE ACTUAL PPN
HRROI T1,.GTRS0
GETTAB T1, ;GET SFD #1
JRST MPRTNH ;PRE 7.01
JUMPE T1,MPRTNH ;NO SFD
MOVEM T1,RN.PTH+.PTSFD ;SAVE SFD
MOVEI T1,RN.PTH ;GET POINTER
EXCH T1,RN.PPN ;SWAP WITH PPN
MOVEM T1,RN.PTH+.PTPPN ;SAVE PPN
HRROI T1,.GTRS1
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+1
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS2
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+2
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS3
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+3
JUMPE T1,MPRTNH ;ALL DONE
HRROI T1,.GTRS4
GETTAB T1, ;NEXT SFD
JRST MPRTNH
MOVEM T1,RN.PTH+.PTSFD+4
SETZM RN.PTH+.PTMAX-1 ;TERMINATE WITH ZERO
>
MPRTNH:
HRLZI 17,SAVACS ;RESTORE THE AC'S.
BLT 17,17
JRST (JAC) ;RETURN.
;COME HERE WITH EITHER THE ADDRESS OF A GETSEG ARG BLOCK IN T1 (TOPS10)
; OR A BYT PTR TO THE JFN STRING IN T4 (TOPS20)
RRRTNS: MOVEM PP,SAVACS ;SAVE THE PUSH DOWN POINTER.
RRRTNH:
IFE TOPS20,<
GETSEG T1, ;GETSEG THE HIGH SEGMENT.
HALT RRRTNL ;COULDN'T, GO COMPLAIN.
>;END OF IFE TOPS20.
IFN TOPS20,<
MOVE T2,T4 ; GET BYT PTR OF HIGH SEG JFN STRING
HRLZI T1,(GJ%OLD+GJ%SHT) ; INDICATE SHORT GTJFN OF OLD FILE
GTJFN% ; GET THE HIGH SEG JFN
ERJMP RRRTNL ; ERROR CAN'T GET THE JFN
HRLI T1,.FHSLF ;THIS PROCESS
TXO T1,GT%ADR ;CHECK ADDRESS LIMITS
MOVE T2,[600,,677] ;REST OF HIGH SEGMENT
GET% ;GET THE HIGH SEGMENT
>;END OF IFE TOPS20.
MOVE PP,SAVACS ;RESTORE THE PUSH DOWN POINTER.
;RESTORE THE AC'S THAT LIBOL HAD SAVED WHEN IT MADE THE CHECKPOINT FILE.
..I==0
REPEAT 17,<
POP PP,..I
..I==..I+1>
POPJ PP, ;ANSWER LIBOL'S PUSHJ PP,RRDUMP.
RRRTNL:
IFN TOPS20,<
HRROI T1,[ASCIZ /
?Can't GET the high segment.
/]
PSOUT% ; PRINT MESSAGE
HALTF%
JRST RRRTNH ; RESTART
>; END IFN TOPS20
IFE TOPS20,<
OUTSTR [ASCIZ /
?Can't GETSEG the high segment.
/]
HALT RRRTNH
>;END OF IFE TOPS20.
SAVACS: BLOCK 20 ;PLACE TO SAVE THE AC'S.
IFN TOPS20,<
SAVSTR: BLOCK 20 ;PLACE TO SAVE DEV:<DIR>NAME OF SAVE FILE
>
IFE TOPS20,<
RN.PTH: BLOCK .PTMAX ;FULL PATH SPECIFICATION OF SAVE FILE
>
END