.TITLE CHAIN ; FORTRAN CALLABLE ROUTINE FOR CHAINING BETWEEN PROGRAMS IN ; SAME OR DIFFERENT RUN-TIME SYSTEMS. ; *** ONLY VALID WITH FOR (NOT F4P) UNDER RT11 EMULATOR *** ; ; CALL CHAIN(PROG,LINE,CORCOM,NCHAR,CORSIZ) ; PROG - PROGRAM TO CHAIN TO IN ASCIZ FORMAT. ; LINE - LINE NUMBER OF CHAIN (I.E., FQNENT VALUE) ; CORCOM - BYTE ARRAY TO PASS AS CORE COMMON ; NCHAR - NUMBER OF CHARACTERS IN CORCOM ; CORSIZ - INTEGER*2 <0 IF PROG NOT RT11 .SAV FILE ; =0 IF CURRENT SIZE OK ; >0 EXPAND TO CORSIZ BEFORE ; DOING RT11 CHAIN. .MCALL .PRINT,.CHAIN,.CSISPC .SETFQB = EMT+360 .DORUN = EMT+363 .PRTERR = EMT+364 .GETCOR = EMT+366 FIRQB = 402 FQPPN = 6 PROG = 2 LINE = 4 CORCOM = 6 NCHAR = 10 CORSIZ = 12 SPACES = 40+<400*40> ;TWO ASCII SPACES CHAIN:: MOV SP,R4 ;SWITCHES IN FILESPEC PUSHED ON STACK TSTB @PROG(R5) ;A ZERO MEANS LET CSISPC PROMPT BEQ 10$ .CSISPC #OUTSPC,#DEFEXT,PROG(R5) BR 20$ 10$: .CSISPC #OUTSPC,#DEFEXT,#0 20$: BCS BADNAM MOV R4,SP ;RESTORE SP IN CASE SWITCHES GIVEN TST @CORSIZ(R5) ;WHAT KIND OF CHAIN? BLT DORUN ;<0 MEANS WE MUST "RUN" NOT "CHAIN" BEQ RCHAIN ;=0 MEANS CHAIN WITH CURRENT CORE SIZE. ;MUST NOW EXPAND BEFORE CHAINING. MOV @CORSIZ(R5),R0 ;SIZE REQUESTED FOR EXPAND. .GETCOR ;PREPARE FOR FAILURE IF EMT BOMBS. BCS TOOBIG ;CARRY BIT SET IF ERROR IN EMT RCHAIN: MOV #500,R1 ;POINT TO PARAMETER AREA MOV #FILNAM,R0 ;GET ADDRESS OF NAME OF PROG .SETFQB ;RECOVER A PPN, IF ANY IN ORIGINAL MOV @#FIRQB+FQPPN,@54 ;LOAD PPN INTO ONE-SHOT AREA MOV (R0)+,(R1)+ ;MOVE IN NAME OF CHAINEE MOV (R0)+,(R1)+ MOV (R0)+,(R1)+ MOV (R0)+,(R1)+ CALL PUTCC ;NOW INSERT CORCOM ARRAY .CHAIN ; .EXIT ;CHAIN WILL NEVER RETURN, EVEN IF FAILURE. DORUN: MOVB @NCHAR(R5),@#460 ;NUMBER OF CHAR IN CORE COMMON MOV #461,R1 ;BASIC'S CORE COMMON IS AT 460 CALL PUTCC MOV #FILNAM,R0 ;ADDRESS OF RT11 TYPE FILEBLOCK .SETFQB ;RECOVER A PPN, IF ANY IN ORIGINAL MOV @#FIRQB+FQPPN,@54 ;LOAD PPN INTO ONE-SHOT AREA MOV @LINE(R5),4*2(R0) ;LINE NUMBER - VERSION 7.0 .DORUN ;DO A RSTS .RUN AFTER UNDOING RT11 STUFF BADNAM: MOVB @#FIRQB,R0 ;GET THE RETURNED RSTS ERROR CODE. .PRTERR ;PRINT THE RSTS ERROR. CLR R0 .PRINT ;ADD THE CR/LF RETURN PUTCC: MOV CORCOM(R5),R2 MOV @NCHAR(R5),R3 1$: MOVB (R2)+,(R1)+ SOB R3,1$ RETURN TOOBIG: .PRINT #NOCORE RETURN OUTSPC: .BLKW 15. FILNAM: .BLKW 24. ;IT'S THE 1ST INPUT FILE WE WANT. DEFEXT: .WORD ^RSAV,0,0,0 NOCORE: .ASCIZ '?BAD CORE SIZE REQUEST' .END