SEARCH MTHPRM,FORPRM TV FORINI INITIALIZE FOROTS LOWSEG, 11(5000) SUBTTL /DAW/JLC/AHM/BL/PLB/CDM 16-Feb-84 ; Previous authors (before V6) ; D. TODD/DRT/HPW/DMN/MD/JNG/SWG/CAL ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987 ;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 AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. COMMENT \ ***** Begin Revision History ***** ***** Begin Version 6 ***** 1262 DAW 9-Feb-81 Allow FORINI to run in a non-zero section. (Assumes that all code is in the same section). 1530 JLC 10-Jul-81 FOROTS becomes FOROT6. 1623 DAW 21-Aug-81 Entry point RESET$ to test extended addressing in FOROTS. 2005 JLC 15-Oct-81 Added REENTER code. Make DDT-20 understand symbol tables at other than 400000. 2007 JLC 16-Oct-81 Fixed temp stack to be larger for reenter code. 2033 DAW 19-Nov-81 Fixed problems in REENTER code. ***** Begin Version 7 ***** 3035 JLC 29-Jan-81 FOROT6 becomes FOROT7. 3056 JLC 23-Mar-82 Rework lowseg/hiseg dispatch, save ACs in lowseg. 3101 JLC 5-Apr-81 Modified lowseg/hiseg interface - address of user's ACs are now passed in F instead of T1. 3102 JLC 7-Apr-82 Fix OTS/NONSHAR, INIT call was going to 0. Slightly modify passing of return address of RESET. - PDL is now in the lowseg. 3103 JLC 8-Apr-82 More minor changes to lowseg/hiseg interface. Stack setup is now done totally in FORINI. 3122 JLC 28-May-82 Change lowseg/hiseg interface again. Now uses 2-word entries. 3123 JLC 29-May-82 Modified interface again to make it faster. 3125 JLC 3-Jun-82 Moved AC save routine to hiseg again. 3137 AHM 30-Jun-82 Development patches for running entirely in a non-zero section for V8. If .JBSA in RESET.'s section contains 0, synthesize reasonable numbers to put in JOBDAT for the current section. Do XGVEC% and XSVEC% to save and restore the program's entry vector. Set up a global stack pointer when running in a non-zero section. Don't pass the address of AU.ACS to INIT. in F, since it isn't used any more. 3156 AHM 21-Jul-82 Don't do XGVEC% and XSVEC% unless we are running in a non-zero section so that we can run UNDER Tops-20 release 4.1 on a KS. Also, do private OPDEFs of PDVOP%, XGVEC% and XSVEC% so that FORINI will assemble with release 4.1 MONSYM. 3163 AHM 24-Aug-82 Make FAKJBD a little more paranoid about blamming the location that 770001 references with a symbol table pointer by checking 770000 for JRST 770002 ala EXEC and OVRLAY. Use section defaulting in RPACS% calls. Don't zero left half of .JBREN. 3177 BL 14-Sep-82 Store DBMS entry vector at .JBBLT. 3202 JLC 26-Oct-82 Install non-skip (error) return from CLOSF. 3205 AHM 28-Oct-82 Add code under IF20 conditional to define %SRTAD (SORT's start address) here, zero it upon restart, and toss the section that SORT is in, if it owns its own section. 3220 AHM 18-Nov-82 Replace non-zero section tests that depended upon the sign of the stack pointer with a check that uses XMOVEI so that we know which section we are currently executing in. 3231 JLC 14-Dec-82 RESET. becomes FOROK. for new DBMS interface. 3235 AHM 16-Dec-82 Fix ACs for entry vector JSYS call around code to GET% FOROTS. 3236 JLC 17-Dec-82 Move setup of FUNCT. in .JBBLT to FORMEM. 3244 JLC 30-Dec-82 Moved setup of FUNCT. back into FORINI, as PORTAL is almost inaccessible from hiseg. Changed the name of DBSTP$ to a FOROTS entry, resolved by a file later in FORLIB if DBMS program, resolved to dummy one if no DBMS program. 3245 JLC 4-Jan-82 Look at %DBSTP to determine whether to GETSEG FOROT7.EXE or FDBOT7.EXE. 3246 JLC 5-Jan-83 Put PORTAL back here. 3252 JLC 12-Jan-83 Move KSORT to FORSRT.MAC. 3253 JLC 13-Jan-83 Change %FRSNONSHARE to %FRSNS. Change %FRSLOAD to %FRSLO. Fix CLSFIL to set up 'STOP!!' on stack to stop traceback loop. 3254 CKS 13-Jan-83 Do not set up .JBHSO so that FOROTS symbols will not be seen by DDT unless user explicitly requests them by setting up .JBHSO. 3260 JLC 17-Jan-83 Make KSORT an EXTERN on the -10 so it will be drawn in to get %SRTAD. ***** End V7 Development ***** 3354 TGS 3-Oct-83 SPR:NONE Move setup of DBMS entry vector from FORINI to FOROTS. Store FUNCT address in .JBBLT+2 as well as .JBBLT. BEGIN V10 4000 JLC 22-Feb-83 Make RESET$ entry restartable. 4002 JLC 23-Feb-83 Code review changes. 4006 JLC 28-Feb-83 FOROT7 becomes FORO10. 4022 PLB 28-Jun-83 Ream FORINI so it will get FOROTS into another section, this includes section searching. 4023 JLC 29-Jun-83 Move CHRPT. from here to FORCHR. Insert global symbols F.BOT and F.TOP, both set to zero, to resolve them and keep them out of the way for FORMEM. 4025 JLC 1-Jul-83 Add arg block for user subroutine calls on library traps. 4031 JLC 7-Jul-83 Fix JBHRL so it looks like LINK built it. 4037 JLC 31-Aug-83 Modify GET code to allow for FORO10.EXE having a page 0, which will now be ignored. 4042 JLC 8-Sep-83 Fix GTFRSX so that it will avoid page 0 of FOROTS for non-zero sections. 4065 JLC 6-Dec-83 Just some cleanup. 4066 JLC 11-Jan-84 Just a little bit more cleanup. 4072 JLC 24-Jan-84 New lowseg/hiseg value-passing interface. 4101 CDM 16-Feb-84 Create and expand the character stack differently when running in extended addressing. Give the stack its own section(s) so that it has plenty of room. Also add user subroutine ALCCHR. 4104 JLC 23-Feb-84 Add a new internal which is (FLGVX. V FLG77.) for use in subroutine entries. 4111 JLC 16-Mar-84 Moved code around to eliminate the "percented" entry points in FOROTS, and avoid loading the GETSEG code if there is nothing to GETSEG. 4112 JLC 19-Mar-84 Removed code for FDBOTS, no longer needed. 4116 JLC 6-Apr-84 Fix DOCLS, stack setup was not updated for extended addressing. 4117 JLC 26-Apr-84 Fix DOCLS for TOPS-20 entry vector. 4122 JLC 2-May-84 Fix .JBSYM so it has IOWD format symbol pointer for FORDDT and FORERR. 4123 JLC 5-May-84 Install REENT., the reenter address for /EXTEND. By default a REENTER command will go to code which merely does an EXIT (TOPS-10) or a CLOSF and HALTF (TOPS-20). 4127 JLC 15-May-84 Fixed some TOPS-10 code. 4131 JLC 12-Jun-84 Fix %EXTND, broken in some previous rework. 4134 JLC 3-Jul-84 Fix REENTER, was broken by half-word fixup. Make it Polish, so it will get a full-word fixup. 4144 JLC 29-Aug-84 Remove code to put FOROTS in its own section, since this would make it impossible to use V7 and non-extend rel files with extended code. 4147 MRB 11-Sep-84 Change the symbol named FLGVX. to FLGV. 4152 JLC 24-Sep-84 Remove FAKJBD, replaced with much enhanced code in FORMEM. Add new RESET entry point for use by FORDDT which sets a flag to prevent the RESET. call from the FORTRAN program from doing another one. 4153 JLC 27-Sep-84 Fix start address recording problem introduced by edit 4152, by adding an entry in the initialization arg block containg the start address. 4155 JLC 4-Oct-84 Modify REENTER behavior to what it should have been - HALTF% or EXIT 1, and do not close any files. 4203 JLC 13-Mar-85 Fix REENTER on TOPS-10. 4204 MRB 15-Mar-85 Moved DUMVAX and DUMF77 to here from FORINI. Aleviates the undefinied globals when searching FORLIB for math routines in a non-FORTRAN program. ***** End V10 Development ***** ***** End Revision History ***** ***** Begin Version 11 ***** 5000 TGS 1-Jul-85 Implement RMS OPEN and change FORO10 to FORO11 \ SEGMENT CODE ENTRY FOROT.,FOROT$,FINIT. EXTERN %DBSTP,%EXTND,FLG77.,FLGV. EXTERN KCHST.,KDBMS.,KSORT. EXTERN %LARGL EXTERN %GOGET INTERN F.TOP,F.BOT,F.BHS,FLGON.,%ENTVC,%GTSEC,%EXICL DEFINE X(E) FORVEC F.BHS==0 ;BOTTOM OF FOROTS HIGH SEGMENT IS ZERO F.TOP==0 ;TOP AND BOTTOM OF FOROTS ARE F.BOT==0 ;ZERO FOR /OTS:NONSHARE FLGON.==FLGV.!FLG77. ;[4147] NON-ZERO IF EITHER VAX OR ANSI FLAGGING ;RESET. WILL GETSEG FOROTS IF IT WAS NOT LOADED WITH THE PROGRAM. ;IF FOROT% HAS NOT BEEN DEFINED, IT IS RESOLVED IN ;FORNON, AND FOROTS WILL BE LOADED WITH THE USER PROGRAM. ;IF FOROT% HAS BEEN DEFINED, EITHER BY ;LINK OR IN THE LINK COMMAND STRING, THE GETSEG ROUTINE IS LOADED. ; ;CALL: ; JSP 16,RESET. ; 0 ;ARG, IGNORED ; ;RETURNS WITH FOROTS PRESENT AND INITIALIZED. SETS UP P. ;CAN DESTROY ALL ACS FINIT.: SETOM FDDTFL ;SET THE "INIT FROM FORDDT" FLAG JRST INCOM ;JOIN COMMON INIT CODE FOROT.:! PORTAL .+1 ;ALLOW ENTRY FROM PUBLIC SKIPN FDDTFL ;DID WE JUST INIT FROM FORDDT? JRST INCOM ;NO. JUST A PLAIN OLD INIT CALL SETZM FDDTFL ;YES. MAKE SURE WE DON'T LEAVE IT THAT WAY XMOVEI T1,@L ;[4153] GET RETURN ADDRESS SUBI T1,2 ;[4153] POINT TO START ADDRESS OF PROGRAM MOVEM T1,STADR ;[4153] SAVE IT FOR FORERR JRST 1(L) ;AND RETURN TO USER IMMEDIATELY ;SINCE WE DON'T WANT TO RESET FORDDT'S INIT INCOM: SKIPN [%EXTND] ;DO WE WANT TO RUN IN SECTION 1? JRST NOMAP ;NO. DON'T FOROT$:! PORTAL .+1 ;ALLOW ENTRY FROM PUBLIC SKIPE MAPPED ;[4022] ALREADY MAPPED? JRST DOEXTJ ;YES. DON'T TRY AGAIN XMOVEI T1,. ;GET CURRENT SECTION IN LH TLNE T1,-1 ;ALREADY IN NON-ZERO SECTION? JRST NOMAP ;YES. DON'T MAP SECTIONS TOGETHER MOVE P,[IOWD LPDL,INIPDL] ;[4022] SET UP LOCAL STACK (TEMP) PUSHJ P,%GTSEC ;[4022] FIND A FREE SECTION JRST MAPERR ;[4022] NO YOU DON'T MOVEM T1,SECNUM ;SAVE THE SECTION NUMBER PUSHJ P,MAPSEC ;MAP SECTION ZERO TO SOME NON-ZERO SECTION SETOM MAPPED ;FLAG WE ARE MAPPED DOEXTJ: SETZ T1, ;[4022] FLAGS HRLZ T2,SECNUM ;[4131] GET SECTION NUMBER HRRI T2,EXTJ ;[4022] ,, PC XJRSTF T1 ;[4022] JUMP! EXTJ: HRL L,SECNUM ;[4022] AND PUT A SECTION NUMBER IN RETURN ADDR NOMAP: XMOVEI P,INIPDL-1 ;[3137] Set up a global stack TLNN P,-1 ;[3137] Is there a section number ? HRLI P,-LPDL ;NO. USE A LOCAL STACK PUSH P,['STOP!!'] ;FLAG BOTTOM OF STACK FOR TRACEBACK PUSH P,L ;PUSH RETURN ADDR FROM JSP XMOVEI T1,@L ;[4153] GET RETURN ADDRESS SUBI T1,2 ;[4153] POINT TO START ADDRESS OF PROGRAM MOVEM T1,STADR ;[4153] SAVE IT FOR FORERR PUSHJ P,KCHST. ;[4101] Kill the character stack. PUSHJ P,KDBMS. ;KILL PREVIOUS TRACES OF DBMS PUSHJ P,KSORT. ;[3205] Get rid of SORT, if it is present PUSHJ P,SETEV ;GET ENTRY VECTOR, SETUP REENTER IN IT PUSHJ P,%GOGET ;GO GET FOROTS XMOVEI L,INIARG ;PASS ARG LIST OF PARAMETERS PJRST INIT. ;GO TO FOROTS INITIALIZATION -ININUM,,0 ;[4153] ARG COUNT (ALA FORTRAN CALL) INIARG: IFIW %DBSTP ;PASS ADDRESS OF DBSTP$ OR POPJ P, IFIW %LARGL ;PASS ADDRESS OF LIBRARY ERROR ARG LIST IFIW [FLGV.] ;[4147] ADDRESS OF VAX COMPATIBILITY FLAG IFIW [FLG77.] ;ADDRESS OF ANSI-77 FLAG IFIW STADR ;[4153] START ADDRESS OF USER'S PROGRAM ININUM=.-INIARG CLSMSG: ASCIZ /Do you want to close all files? (Y or N):/ MAPMSG: ASCIZ /Can't map up section 0 / SEGMENT DATA STADR: BLOCK 1 ;[4153] START ADDRESS OF USER'S PROGRAM FDDTFL: BLOCK 1 ;FLAG FOR "FORDDT DID THE INIT CALL" SECNUM: BLOCK 1 ;SECTION # TO WHICH WE ARE MAPPED MAPPED: BLOCK 1 ;IF .NE. 0, WE ARE MAPPED TO ANOTHER SECTION INIPDL: BLOCK LPDL ;FOR NOW THE PERM PDL USEREN: BLOCK 1 ;USER REENTER ADDR YESWRD: BLOCK 1 ;WORD FOR USER RESPONSE %ENTVC: BLOCK 2 ;SAVED ENTRY VECTOR SEGMENT CODE ;JOBDAT CODE FOR REENTER ADDRESS FIXUP USJOBD: SKIPN T1,.JBREN ;DOES USER HAVE .JBREN ADDR? MOVEI T1,%EXICL ;NO. USE AN EXIT CALL HRRZ T2,T1 ;Did we already do this? CAIN T2,CLSFIL POPJ P, ;YES. DON'T DO IT AGAIN HRLI T1,(JRST) ;MAKE IT A LOCAL INSTRUCTION MOVEM T1,USEREN ;TO EXECUTE AFTER %EXIT1 MOVEI T1,CLSFIL ;[3137] Used to close all files HRRM T1,.JBREN ;[3137] When user types "REENTER" POPJ P, IF10,< SETEV: JRST USJOBD ;USE JOBDAT CODE FOR ENTRY VECTOR SETUP %GTSEC: MOVEI T1,1 ;FOR NOW, JUST RETURN SECTION 1 AOS (P) ;SKIP RETURN POPJ P, MAPSEC: MOVE T1,SECNUM ;GET SECTION NUMBER TXO T1,PG.GMS ;MAP IT TO SECTION 0 MOVEM T1,MAPBLK+1 ;SAVE FOR PAGE. MOVEI T1,1 ;1 ARGUMENT MOVEM T1,MAPBLK MOVE T1,[.PAGSC,,MAPBLK] PAGE. T1, ;MAP THEM JRST MAPERR ;CAN'T POPJ P, CLSFIL: OUTSTR CLSMSG ;GIVE USER A MSG INCHWL T1 ;GET THE FIRST CHAR CLRBFI ;CLEAR TYPE-AHEADS ;[4203] CAIE T1,"Y" ;CHECK FOR UPPER AND LOWER CASE Y CAIN T1,"y" JRST DOCLS ;YES, IT'S YES XCT USEREN ;[4155] EXECUTE REENTER INST EXIT 1, ;[4155] DO A MONRET JRST .-1 ;[4155] AND DON'T ALLOW CONTINUATION DOCLS: XMOVEI P,INIPDL-1 ;[3137] Set up a global stack TLNN P,-1 ;[3137] Is there a section number ? HRLI P,-LPDL ;NO. USE A LOCAL STACK PUSH P,['STOP!!'] ;FLAG BOTTOM OF STACK FOR TRACEBACK XMOVEI L,[1+[EXP 0,0]] ;NULL ARGS PUSHJ P,EXIT1. ;CLOSE ALL FILES NDOCLS: XCT USEREN ;EXECUTE REENTER INST %EXICL: EXIT ;HALT FOROTS MAPERR: OUTSTR MAPMSG ;CAN'T MAP TO A NON-ZERO SECTION EXIT SEGMENT DATA MAPBLK: BLOCK 2 ;A SHORT PAGE BLOCK SEGMENT CODE >;END IF10 IF20,< SETEV: MOVEI T1,.FHSLF ;[3137] Reference this fork XGVEC% ;[3137] Get entry vector length and address ERJMP S0GVEC ;NOT RUNNING ON A MODEL B JRST S1GVEC ;[3156] Interpret the entry vector S0GVEC: MOVEI T1,.FHSLF ;[3137] Reference this fork GEVEC% ;[3156] Get entry vector info using old call HRRZ T3,T2 ;[3235] Put the address where XGVEC% puts it HLRZ T2,T2 ;[3235] Put the length in the right half S1GVEC: DMOVEM T2,%ENTVC ;[3137] Save it CAIE T2,(JRST) ;[3137] Real entry vector? CAIG T2,1 ;[3137] Yes, big enough? JRST USJOBD ;NO. USE JOBDAT SKIPN T1,1(T3) ;[3137] Get reenter instruction MOVE T1,[JRST %EXICL];USE OURS IF NONE CAMN T1,[JRST CLSFIL] ;Already setup? (Program re-started?) POPJ P, ;YES. DON'T DO IT AGAIN TLNN T1,-1 ;ANY OPCODE? HRLI T1,(JRST) ;NO. PUT IN A JRST MOVEM T1,USEREN ;TO EXECUTE AFTER %EXIT1 MOVE T1,[JRST CLSFIL];USED TO CLOSE ALL FILES MOVEM T1,1(T3) ;[3137] When user types "@REENTER" POPJ P, MAPSEC: MOVSI T1,.FHSLF ;THIS FORK IN SECT 0 MOVSI T2,.FHSLF ;[4022] THIS FORK ,, HRR T2,SECNUM ;[4022] CORRECT SECTION MOVX T3,SM%RD!SM%WR!SM%EX+1 SMAP% ;MAP SECTIONS 0 & N TOGETHER ERJMP MAPERR ;CAN'T POPJ P, CLSFIL: MOVE T1,[POINT 7,CLSMSG] ;GIVE USER A MSG PSOUT% MOVE T1,[TXIBLB,,TXIBLK] ;Copy args to TXIBLK BLT T1,TXIBLK+.TXLEN-1 XMOVEI T1,TXIBLK ;SETUP FOR TEXTI TEXTI% JFCL ;?Failed ;Clear input buffer. MOVEI T1,.PRIIN ;Get terminal designator CFIBF% ;Clear input buffer ERJMP .+1 ;Ignore error LDB T1,[POINT 7,YESWRD,6] ;GET THE 1ST CHAR CAIE T1,"Y" ;CHECK FOR UPPER AND LOWER CASE Y CAIN T1,"y" JRST DOCLS ;YES, IT'S YES XCT USEREN ;[4155] EXECUTE REENTER INST HALTF% ;[4155] STOP THE PROGRAM JRST .-1 ;[4155] AND DON'T ALLOW CONTINUATION DOCLS: XMOVEI P,INIPDL-1 ;[3137] Set up a global stack TLNN P,-1 ;[3137] Is there a section number ? HRLI P,-LPDL ;NO. USE A LOCAL STACK PUSH P,['STOP!!'] ;FLAG BOTTOM OF STACK FOR TRACEBACK XMOVEI L,[1+[EXP 0,0]] ;NULL ARGS PUSHJ P,EXIT1. ;CLOSE ALL FILES NDOCLS: XCT USEREN ;EXECUTE REENTER INST %EXICL: MOVNI T1,1 ;CLOSE ALL OTHER FILES CLOSF% $FCALL IOE ;REPORT WHATEVER ERROR IT IS HALTF% ;STOP FOROTS JRST .-1 ;AND STAY THAT WAY MAPERR: HRROI T1,MAPMSG ;GET MESSAGE ESOUT% HALTF% JRST .-1 TXIBLB: .RDRTY ;LENGTH FOLLOWING RD%TOP!RD%JFN ;STOP ON TOPS-10 STYLE CODES .PRIIN,,.PRIOU ;INPUT,,OUTPUT POINT 7,YESWRD ;THE ANSWER POINTER 5 ;5 BYTES MAX POINT 7,YESWRD ;THE DELETE-UP-TO-HERE POINTER POINT 7,CLSMSG ;THE GIVE-ME-BACK-THAT-PROMPT POINTER .TXLEN==.-TXIBLB ;Length of block SEGMENT DATA TXIBLK: BLOCK .TXLEN ;Real TEXTI block. SEGMENT CODE ; New [4022]/PLB FNDSEC; FIND A FREE SECTION %GTSEC: MOVSI T3, -37 ;[4022] SEARCH 1..37 FNDLOP: MOVSI T1, .FHSLF ;[4022] GET FORK (THATS US) HRRI T1, 1(T3) ;[4022] SNEAK SECTION IN RSMAP% ;[4022] READ SECTION MAP ERJMP FNDRET ;[4022] YOU LOSE BIG AOJE T1, FNDGOT ;[4022] IN USE? (NOT -1) AOBJN T3, FNDLOP ;[4022] FRAID SO POPJ P, ;[4022] I'M SORRY YOUR TIME IS UP. FNDGOT: MOVEI T1, 1(T3) ;[4022] RETURN SECTION IN T1 AOS (P) ;[4022] GIVE HAPPY RETURN FNDRET: POPJ P, ;[4022] HOMEWARD BOUND SEGMENT DATA PDVARG: EXP PDVLEN ;[3137] Length of the block EXP .FHSLF ;[3137] This process EXP PDVALN ;[3137] Data block length BLOCK 1 ;[3137] Address of associated data block (PDVA) PDVLEN==.-PDVARG ;[3137] Length of this block ;[3137] PDVA: BLOCK 1 ;[3137] Gets address of PDV PDVALN==.-PDVA ;[3137] Length of this block SEGMENT CODE >;END IF20 PRGEND SEARCH MTHPRM,FORPRM TV FORNON NON-SHARE MODULE ;THIS MODULE IS REACHED IF LINK DOES NOT DEFINE FOROT%, THAT IS, IF ;WE ARE LOADING /OTS:NONSHARE OR WITH /SEARCH. THIS MODULE IS HERE ;TO REMOVE ALL OTHER TRACES OF THE SYMBOL FOROT% FROM FOROTS. ENTRY FOROT% INTERN %GOGET SEGMENT CODE FOROT%==0 ;IF DEFINED HERE, FORCES LOADING OF FOROTS %GOGET: POPJ P, PRGEND SEARCH MTHPRM,FORPRM TV FORGET GETSEG FOROTS SEGMENT CODE ENTRY %GOGET EXTERN %GTSEC,%ENTVC DEBUG==1 ;[4022] NON-ZERO FOR DEBUG CODE DDTPAG==766 ;BOTTOM PAGE OF CURRENT DDT %GOGET: SKIPE T1,FBASE ;FOROTS ALREADY GETED? POPJ P, ;YES. DON'T GET IT AGAIN IF10,< JS.XO==2000 ;JBTSTS BIT, JOB IS EXECUTE ONLY MOVEM P,SAVET ;SAVE P, GETSEG DESTROYS IT HRROI T1,.GTSTS ;GET JOB STATUS GETTAB T1, SETZ T1, ;CAN'T, ASSUME NOT EXECUTE ONLY TRNN T1,JS.XO ;EXECUTE ONLY? TDZA T2,T2 ;NO MOVEI T2,UU.PHY ;YES, SET FOR PHYS-ONLY GETSEG MOVEI T1,FOROTS DOGETS: GETSEG T1,(T2) HALT ;FAILED, TYPE MONITOR ERROR MESSAGE MOVE P,SAVET ;GETSEG WRECKED P, GET IT BACK MOVE T1,[-2,,.GTUPM] ;GET BASE ADDRESS OF HIGH SEG (FOROTS) GETTAB T1, JRST GETFAL ;SHOULDN'T FAIL HLRZ T1,T1 ;PUT IN RIGHT HALF TRZ T1,777 ;CLEAR EXTRA BITS TRO T1,10 ;START ADDRESS IS XXX010 SUBI T1,RBASE ;SUBTRACT TABLE OFFSET MOVEM T1,FBASE ;STORE FOR LATER POPJ P, ;DONE GETFAL: OUTSTR [ASCIZ /?Cannot find base address of FOROTS /] EXIT FOROTS: 'SYS ' 'FORO11' ;[5000] EXP 0,0,0,0 > ;IF10 IF20,< MOVX T1,RF%LNG+.FHSLF ;FUNNY CALL,,THIS FORK MOVEI T2,STBLK ;POINT TO FORK STATUS BLOCK RFSTS% ;READ FORK STATUS SKIPL STBLK+.RFSFL ;SEE IF WE ARE EXECUTE ONLY SKIPA T1,[GJ%SHT+GJ%OLD] ;NO, SET UP FOR REGULAR GTJFN MOVX T1,GJ%SHT+GJ%OLD+GJ%PHY ;YES, SET UP FOR PHYSICAL-ONLY GTJFN HRROI T2,[ASCIZ /SYS:FORO11.EXE/] ;[5000] GTJFN% ERJMP RERR HRRZM T1,FRSJFN ;SAVE THE JFN PUSHJ P,GTFRSX ;[4022] SETUP FOR SECTION N GET% GET% ;GET FOROTS ERJMP RERR XMOVEI T1,. ;[4022] GET OUR SECTION HLRZ T1,T1 ;[4022] PUT IN RIGHT HALF CAME T1,GARGBL+.GBASE ;[4022] SAME AS FOROTS SECTION? PUSHJ P,FRSJBD ;[4022] NO, MAKE A JOBDAT FOR FOROTS MOVEI T1,.FHSLF ;THIS FORK XMOVEI T2,0 ;[4022] SECTION 0? JUMPN T2,GOGET1 ;[4022] NO, GET XTENDED ENTRY VECTOR GEVEC% ;GET FOROTS ENTRY VECTOR MOVEI T3,(T2) ;[4022] ADDR ONLY, WHERE XGVEC LEAVES IT HLRZ T2,T2 ;[4022] GET ENTRY VECTOR LENGTH TRNA ;[4022] PRETEND WE JUST DID AN XGVEC GOGET1: XGVEC% ;[4022] GET START ADDRESS W/ SECTION CAIE T2,(JRST) ;[4022] IF NOT TOPS-10 ENTRY VECTOR HRR T3,(T3) ;[4022] GET ENTRY ADDRESS W/ SECTION XMOVEI T2,(T3) ;[4022] GET EXTENDED ADDR THEREOF XMOVEI T4,RBASE ;GET EXTENDED ADDR OF TABLE OFFSET SUB T2,T4 ;[4022] SUBTRACT TABLE OFFSET MOVEM T2,FBASE ;[4022] SAVE BASE ADDRESS OF DISPATCH VECTOR TRZ T3,777 ;GET JUST PAGE-ALIGNED ADDRESS HLRZ T2,.JBHRN(T3) ;GET SEGMENT LENGTH ADDI T2,-1(T3) ;CALC TOP ADDR OF FOROTS IORI T2,777 ;MAKE IT THE END OF THE PAGE HLL T2,.JBHRN(T3) ;MAKE .JBHRL LOOK LIKE ON THE -10 SKIPN .JBHRL ;AND IF THE USER DIDN'T HAVE ONE MOVEM T2,.JBHRL ;SAVE FOR DDT IFN DEBUG,< ;[3254] USE THIS FOR DEBUGGING; REMOVED FOR ;[3254] PRODUCTION XMOVEI T1,(T3) ;GET EXTENDED ADDR LSH T1,-9 ;CREATE PAGE ADDR SKIPN .JBHSO ;AND IF THE USER DOESN'T HAVE ONE MOVEM T1,.JBHSO ;SAVE THE FOROTS HIGH SEG ORIGIN FOR DDT XMOVEI T1,. ;[4022] GET OUR SECTION HLRZ T1,T1 ;[4022] GET IN RIGHT HALF CAMN T1,GARGBL+.GBASE ;[4022] SAME AS FOROTS? JRST GOGET2 ;[4022] YES, PMAP WILL DIE MOVE T1,[.FHSLF,,770] ;[4022] IS DDT ACCESSIBLE? RPACS% ;[4022] GET ACCESS INFO $FJCAL IJE,ABORT. ;[4022] SHOULD NEVER FAIL JUMPE T2,GOGET2 ;[4022] NO DDT MOVE T1,770000 ;[4022] GET FIRST WORD OF 'DDT' CAME T1,[JRST 770002] ;[4022] IS IT FOR REAL? JRST GOGET2 ;[4022] NO XMOVEI T1,DDTPAG*1000 ;[4022] GET DDT BOTTOM ADDR LSH T1,-9 ;[4022] MAKE PAGE HRLI T1,.FHSLF ;[4022] IN US MOVE T2,GARGBL+.GBASE ;[4022] GET DESTINATION SECTION # LSH T2,9 ;[4022] PAGEIFY ADD T2,[.FHSLF,,DDTPAG] ;[4022] DESTINATION MOVE T3,[PM%CNT!PM%RWX+<1000-DDTPAG>] ;[4022] ACCESS INFO PMAP% ;[4022] MAP THE PAGES TOGETHER $FJCAL IJE,ABORT. ;[4022] SHOULD NEVER FAIL! GOGET2: > ;IFN DEBUG MOVEI T1,.FHSLF ;THIS FORK DMOVE T2,%ENTVC ;[3137] Put real entry vector back XMOVEI T4,0 ;[3220] See what section the ACs are in JUMPE T4,S0SVEC ;[3220] Do a SEVEC% if we are in section 0 XSVEC% ; SO ^C, START WORKS POPJ P, ;DONE S0SVEC: HRLZ T2,T2 ;[3235] Put the size in the left half HRR T2,T3 ;[3235] Put the address in the right half SEVEC% ;[3156] Set the entry vector with an old call POPJ P, ;DONE ;Call here to do setup for GET% into any section ;Exits with AC1 and AC2 set up for GET% GTFRSX: MOVX T1,GT%BAS!GT%LOW ;Tell monitor to look at .GBASE in GARGBL MOVEM T1,GARGBL+.GFLAG ;STORE FLAGS XMOVEI T1,GARGBL ;[4022] GET SECTION FOR ARGBLOCK HLRZ T1,T1 ;GET SECTION NUMBER IN RH MOVEM T1,GARGBL+.GBASE ;[4022] STORE SECTION NUMBER MOVEI T2,(T1) ;COPY THE SECTION NUMBER LSH T2,^D9 ;MAKE IT A PAGE NUMBER ADDI T2,1 ;IGNORE PAGE 0 WITHIN IT MOVEM T2,GARGBL+.GLOW ;ON THE GET MOVE T1,FRSJFN ;GET JFN TDO T1,[.FHSLF,,GT%NOV!GT%ARG] ;[4022] THIS FORK, ;ERROR IF PAGES EXIST, USE ARG BLOCK XMOVEI T2,GARGBL ;[4022] GET% ARG BLOCK POPJ P, ;Back to main code RERR: HRROI T1,RERRBF ;POINT TO MESSAGE BUFFER HRLOI T2,.FHSLF ;THIS FORK,,LAST ERROR MOVSI T3,-^D80 ;LIMIT OF 80 CHARS ERSTR% ;GET ERROR STRING JRST [HRROI T1,[ASCIZ /Undefined error number/] JRST RQUIT] SKIPA T1,[-1,,[ASCIZ /Error in ERSTR/]] HRROI T1,RERRBF RQUIT: MOVEM T1,SAVET ;SAVE T1 FOR A WHILE HRROI T1,[ASCIZ /Can't get FORO11.EXE/] ;[5000] ESOUT% ;TYPE EXPLANATION MOVE T1,SAVET ;GET POINTER BACK ESOUT% ;TYPE ERROR STRING HALTF% ;QUIT AND DON'T CONTINUE JRST .-1 ; [4022] New /PLB; Create crucial JOBDAT locations in FOROTS' section ; when FOROTS resides in another section. FRSJBD: HRLZ T2,GARGBL+.GBASE ;GET FOROTS SECTION MOVEI T1,.JBDA ;GET VALUE MOVSM T1,.JBSA(T2) ;STORE INITIAL FIRST FREE LOCATION MOVEM T1,.JBFF(T2) ;STORE FIRST FREE LOCATION MOVEI T1,777 ;GET VALUE MOVEM T1,.JBREL(T2) ;SET LOWSEG LOWER BOUND POPJ P, SEGMENT DATA STBLK: 5 ;LENGTH OF RFSTS BLOCK BLOCK 4 ;RFSTS BLOCK GARGBL: BLOCK 4 ;"GET" arg block RERRBF: BLOCK ^D80/5 ;BUFFER FOR ERROR MESSAGE SEGMENT CODE > ;END IF20 ;DISPATCH VECTOR. JUMP TO APPROPRIATE PLACE IN FOROTS DISPATCH VECTOR DEFINE X (E) < INTERN E'. SIXBIT /E'./ E'.: PUSHJ P,RDISP > XALL RVEC: FORVEC SALL RBASE==RVEC+1 ;LOCAL RETURN PC-1 ON CALL FROM 1ST ENTRY ;THE FOLLOWING LOWSEG/HISEG INTERFACE ALLOWS FORGET TO BE IN ;A DIFFERENT SECTION THAN FOROTS. FBASE IS THE ENTRY VECTOR ;ADDRESS, MINUS THE OFFSET OF THE TRANSFER VECTOR TABLE (RVEC). ;RDISP JUST DOES A JUMP TO FOROTS, WITHOUT SAVING ANY AC'S. ;IT IS EXPECTED THAT EITHER THE AC'S ARE STORED SEPARATELY (E.G. INIT) ;OR STORED BY THE HISEG ENTRY POINT RDISP: EXCH 0,(P) ;GET RETURN ADDR, SAVE 0 ADD 0,FBASE ;RELOCATE TO FOROTS ENTRY POINT EXCH 0,(P) ;GET 0 BACK, SAVE ENTRY POINT POPJ P, ;GO TO IT SEGMENT DATA FBASE: BLOCK 1 ;FOROTS BASE ADDR MINUS TABLE OFFSET SAVET: BLOCK 1 ;RANDOM TEMP FRSJFN: BLOCK 1 ;FOROTS' JFN SRETAD: BLOCK 1 ;RETURN ADDR OF CALL TO SDISP SEGMENT CODE PRGEND TITLE DUMEXT ENTRY %EXTND ;THIS MODULE IS LINKED IF EXTEND HAS NOT BEEN CALLED IN THE ;USER PROGRAM. IT RESOLVES THE GLOBAL SYMBOL %EXTND, WHICH DETERMINES ;WHETHER THE USER WISHES TO RUN IN A NON-ZERO SECTION. %EXTND==0 PRGEND TITLE FORREN REENTER ADDRESS FOR /EXTEND ENTRY REENT. EXTERN %EXICL REENT.==<%EXICL+0> END