S: / / .PAL BLOAD/E/W / .LOAD BLOAD / .SA SYS BLOAD;3000=2000 / VERSON= "B&77 /VERSION WORD LOCATED AT TAG "VERLOC" PATCH= "0&77 / .R BLOAD TO GET BLOAD VERSION NUMBER / /CORRECTIONS MADE FOR V4 1975 / .MADE SWAP ROUTINE A REAL SWAP / ./V FOR VERSION NUMBER / ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES / .ADJUST JSW FOR /K / .CORRECTED CCB FOR /K / .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8 / .TEST FOR BATCH RUNNIG / .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE / CAN BE DONE FROM A .SV FILE WITH A / FILE STATEMENT / / 30-APR-77 UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT / RUNNING / 05-DEC-77 START COMMERCIAL BASIC FIELD 1 CHANGES / 31-JAN-78 ADD 7 BIT ASCII SUPPORT / 22-MAR-78 ADD GENERAL 2 PAGE /Commercial BASIC Loader, EX / / / / / / / / / / / /COPYRIGHT (C) 1972, 1973, 1974, 1975, 1978, 1979, 1982 /Digital Equipment Corporation, Maynard, Ma. / / / /This software is furnished under a license for use only on a /single computer system and may be copied only with the inclu- /sion of the above copyright notice. This software, or any other /copies thereof, may not be provided or otherwise made available /to any other person except for use on such system and to one who /agrees to these license terms. Title and ownership of the software /shall at all times remain in DEC. / / /The information in this software is subject to change without /notice and should not be construed as a commitment by Digital /Equipment Corporation. / /DEC assumes no responsibility for the use or reliability of its /software on equipment which is not supplied by DEC. / / / / / / /DEC-S8-LBASA-B-LA / /COPYRIGHT C 1972, 1973, 1974,1978,1979, 1982 / /DIGITAL EQUIPMENT CORPORATION /MAYNARD,MASSACHUSETTS 01754 / /AUGUST 19, 1972 / /HANK MAURER, 1972 /SHAWN SPILMAN, 1973 / / / / /ASSEMBLE AND LOAD AS FOLLOW 0 RESADR, 0 PUTLOC, 0 QOUTWRD,0 /MORE COMPILER DEFINITIONS KEYEND= 1665 VARST= KEYEND SVARST= VARST+436 ARAYST= SVARST+1074 SARYST= ARAYST+200 SNUMS= SARYST+200 TEMPS= SNUMS+24 STEMPS= TEMPS+2 LITRL= STEMPS+2 SLITRL= LITRL+2 DATLST= SLITRL+2 INFO= 7604 /BASIC SYSTEM INFORMATION AREA /INFO STARTING BLOCK +1 OF BASIC.SV /INFO+1 STARTING BLOCSYSTEM HANDLER CODE / 27-MAR-78 MAKE BRTS FIELD 1 LOAD CHANGES / 18-APR-78 CLEAN UP CORE IMAGE CREATION LOGIC, REMOVE /C SWITCH / 16-May-78 ADD FANCY ERROR MESSAGES, GENERAL CORESIZE HANDLING / USING /B SWITCH / 17-May-78 PUT IN TEMP FILE READ/WRITE BYPASS OPTIMIZATION / 2/23/79 CHANGED BRTS FIELD 1 LOADING CONSTANTS FOR / ENHANCED HANDLER CHANGE TO BRTS / 5-Mar-79 Make source fixes for published patches / 30-Aug-81 Changed symbol table setup to allow more string / literals / 01-JAN-82 REMOVED BASIC.UF REFERENCES /OS8 BASIC COMPILER POST PROCESSOR /AUTO INDEX REGISTERS X10= 10 X11= 11 X13= 13 STACK= 15 NEXT= 16 /Highest S.T. location used passed by BCOMP AC7775= CLL STA RTL /DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS NOPUNCH /BRTS COMMUNICATIONS REGION *20 STCDF, 0 NSTADR, 0 NASTAD, 0 SSTADR, 0 SASTAD, 0 CODCDF, 0 CODBGN, 0 DATTOP, 0 DATPTR, 0 SWPINF, 0 /BCOMP COMMON REGION *40 VARCNT, 0 SVCNT, 0 ACNT, 0 SACNT, 0 LOCTRH, 0 LOCTRL, 0 BLOCK, 0 HIFLD, 0 BRTS, 0 DLSIZE, 0 ABORTX, 0 FREFLD, 0 /CDF to highest S.T. location used by BCOMP OUTFLG, 0 /Flag passed by BCOMP, zero if no temp file writes done /PAGE 0 LOCATIONS USED BY LOADER FREEHI, 0 FREELO, 0 TEMP, 0 TEMP2, 0 TEMP3, 0 WORD1, 0 WORD2, 0 WORD3, 0 NCHARS, 0 NWORDS, 0 SUBHI, 0 SUBLO, 0 CODSZ1, 0 CODSZ2, 0 LOCHI, 0 LOCLO, 0 CODB, 0 CODF, 0 ICOUNT, 0 OCOUNT, 0 AC1, 0 AC2, 0 AC3, 0 SC, 0 LINEH, 0 LINEL, 0 XLABEL, 0 CLRFLD, 0 CLREND, FIELD 1 BRTND1= 5400 /END OF BRTS FIELD 1 SECTION OVSEP= 7 /OFFSET FROM START OF BLOAD OF BLOAD OVERLAY MAGIC= 1234 /MAGIC NUMBER PASSED IN HIGH ORDER = OPTION FOR FAST /.SV IMAGE STARTUP ENPUNCH /END OF DUMMY SECTIONS /LOADER PROPER *400 LOADER, JMS I (IMAGE /CORE IMAGE FILE PATCH TAD (7577 /EXECUTION RESUMES HERE DCA FREELO CIA IAC DCA SWPINF /SET K +1 OF BCOMP.SV /INFO+2 STARTING BLOCK +1 OF BLOAD.SV /INFO+3 STARTING BLOCK +1 OF BRTS.SV /INFO+4 STARTING BLOCK +1 OF BASIC.OV /INFO+5 STARTING BLOCK +1 OF BASIC.EX /INFO+6 *UNUSED* /INFO+7 *UNUSED* /INFO+10 STARTING BLOCK OF BASIC.TM /INFO+11 SIZE IN BLOCKS OF BASIC.TM /INFO+12 INPUT HANDLER ENTRY ADDRESS /INFO+13 SIZE AND DEVICE NUMBER OF INPUT FILE /INFO+14 STARTING BLOCK OF INPUT FILE /INFO+15 THROUGH /INFO+20 NAME OF WORKSPACE /MISC DEFINES STRMAX= 205 /MAX LENGTH OF STRING IN CHARS STRMIN= 22 /MIN LENGTH TO DEFAULT UNDIMENSIONED STRINGS TO BLDCI= 200 /PAGE WHERE MAKECI GETS MOVED STACKA= 7120 /MAIN STACK OF COMPILER EDTBGN= 0201 /START OF EDITOR EDTSIZ= 2400 /SIZE OF EDITOR JSW= 7746 /OS/8 JOB STATUS WORD IN FIELD 0 CDOPT2= 7642 /HIGH ORDER CD = OPTION AND ALTMODE FLAG CDOPT3= 7643 /CD SWITCHES [ABC DEF GHI JKL] CDOPT4= 7644 /CD SWITCHES [MNO PQR STU VWX] CDOPT5= 7645 /CD SWITCHES [YZ0 123 456 789] CDOPT6= 7646 /LOW ORDER CD = OPTION BIPCCL= 7777 /OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD BABORT= 6 /CONTAINS ADDR OF BCOMP/BLOAD ^C HOOK IN SYS: INBUF= 400 /BLOAD Temp file input buffer in FIELD 1 /overlays BCOMP output buffer XERMSG= 1000 /Error message printer which executes in BCOMP input buffer STPACK= 2000 /LOAD ADDRESS OF STRING ARITH PACKAGE IN FIELD 1 BRTSZ1= 2600 /HANDLER SIZE CONTROL WORD FOR BRTS FIELD 1 CODE BRTLD1= 0000 /STARTING LOCATION OF BRTS LOAD FOR FIELD 1 BRTBG1= 0400 /SUBROUTINE ENTRY ADDR FOR BRTS STARTUP INSWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1 DCA LINEH /CLEAR LINE NUMBER DCA LINEL TAD STACK /ANY UNCLOSED FOR'S ? CIA TAD (STACKA-1 SNA CLA JMP .+3 /NO JMS I (ERMSG /YES UFMSG /UNCLOSED FOR LOOP AC7775 TAD I (7612 /TEST IF 2 PAGE SYSTEM HANDLER SZA CLA /SKP IF YES GOTTD, JMP NOTD8E /JMP IF NO NEED TO ALLOCATE EXTRA PAGE /PREV INSTR NOP'D TO FORCE SPACE IF FOR CORE IMAGE TAD (7377 /ALLOCATE HANDLER EXTENSION PAGE DCA FREELO STL RAR /SET SWAP INFO (17600 OUT NOW) NOTD8E, DCA SWPINF JMS I (FREEF /GET CDF TO HIGHEST FIELD DCA SWPF1 /INTO 2 PLACES TAD SWPF1 DCA SWPF2 TAD SWPF1 /PASS NEW FIELD BITS FOR ANY 2 PAGE HANDLER JMS SWAP /MOVE OS8 OUT JMP I (STSTUF /DO SYMBOL TABLE STUFF /PATCH SYSTEM HANDLER AND MOVE OS/8 OUT OR IN /ENTRY AC = FIELD BITS FOR HANDLER IN BITS 6-8 SWAP, 0 AND (70 /MASK EXTRANEOUS BITS DCA FBITS AC7775 /TEST MAGIC LOCATION IN HANDLER TAD I (7612 /FOR A 3 SZA CLA JMP NOFADJ /NO MATCH, BYPASS ADJUSTMENT TAD (7635 /OK, RELOCATE ANYTHING BEYOND 7635 DCA HNDPTR HNDLP, TAD I HNDPTR /RANGE CHECK BITS 0-8 TAD (-6300 CLL TAD (70 SNL CLA /SKP IF CIF/CDF N0 JMP NOPAT /ELSE TRY NEXT WORD TAD I HNDPTR /OK, NOW GET THE INSTRUCTION BITS AND (7707 TAD FBITS /ADD NEW FIELD DCA I HNDPTR /STORE IT BACK NOPAT, ISZ HNDPTR /BUMP PTR JMP HNDLP /TRY AGAIN NOFADJ, TAD SWPINF /IS ROOM ALLOCATED 2 PAGE SYSTEM HANDLER? SPA CLA /SKP IF NO, JUST MOVE 1 PAGE JMP TD8ESYS /YES JMS SWPSUB /SWAP 17600 TO/FROM N7600 CDF 10 7600 JMP I SWAP TD8ESYS,JMS SWPSUB /SWAP 17600 TO/FROM N7400 CDF 10 7400 JMS SWPSUB /SWAP 27600 TO/FROM N7600 CDF 20 L7600, 7600 SWPRET, CLA JMP I SWAP HNDPTR, 0 FBITS, 0 /SWAPPER SWPSUB, 0 TAD I SWPSUB /GET FIELD DCA SWP1 /TWICE TAD SWP1 DCA SWP2 /ONCE FOR EACH DIRECTION ISZ SWPSUB TAD I SWPSUB /GET HI FIELD ADDR DCA TEMP ISZ SWPSUB TAD L7600 /GET COUNT/POINTER DCA TEMP2 SWP1, HLT TAD I TEMP2 /GET PART OF RESIDENT DCA TEMP3 SWPF1, JMP SWPRET /RETURN IF 8K ONLY TAD I TEMP SWP2, HLT DCA I TEMP2 TAD TEMP3 SWPF2, HLT DCA I TEMP /INTO HI FIELD ISZ TEMP /BUMP POINTER NOP /JR PROTECT AGAINST WRAP AROUND ISZ TEMP2 /AND PTR/CTR JMP SWP1 /LOOP CDF JMP I SWPSUB /Store a word in the symbol table /STBCDF is set up at init time; point to symbol table with X11 /Returns with data field of zero STOSTB, 0 JMP SETUP /Set up the field STOCDF, HLT /Change to symbol table field DCA I X11 /Store the word CDF 0 /Back to field zero JMP I STOSTB /Return to caller SETUP, DCA STOTMP /Save the word TAD STCDF /Get symbol table CDF DCA STOCDF /Store in line TAD (NOP /Clear the initialization DCA STOSTB+1 TAD STOTMP /Restore the data word JMP STOCDF /Store it STOTMP, 0 PAGE NOSL, CDF JMS I (FREEF /SAVE FIELD CIA DCA CLRFLD /FOR ARRAY CLEARING TAD FREELO /SAVE THIS ADDR CIA DCA CLREND /FOR END OF ARRAY CLEAR ISZ FREELO /MAKE IT NEXT FREE + 1 TAD (SVARST-1 DCA X10 /ALLOCATE STRING VARS TAD (-436 DCA TEMP ASVLUP, CDF 10 TAD I X10 /LOOK FOR DEFINED STRING VAR DCA TEMP2 /SAVE SYMBOL NUMBER TAD I X10 /GET SIZE SPA TAD (4000+STRMIN /IF UNDEF USE DEFAULT NO CHARS DCA TEMP3 TAD TEMP2 /IS IT DEFINED ? CDF SMA CLA JMS SVSTOR /YES, CREATE ENTRY ISZ TEMP /BUMP COUNT JMP ASVLUP /LOOP CDF 10 /ALLOCATE STRING TEMPS P6, TAD I (STEMPS+1 DCA STEMPF /INIT FIELD TAD I (STEMPS /AND POINTER SKP STMLUP, TAD TEMP /LOOK AT NEXT ENTRY SNA JMP I (ALLOCA /DONE GO ALLOCATE ARRAYS TAD (-1 DCA X10 /GET POINTER STEMPF, CDF 10 TAD I X10 /GET ADDR OF NEXT ENTRY DCA TEMP /SAVE IT P7, TAD I X10 /AND ITS FIELD DCA STEMPF ISZ X10 /SKIP TEMP NUMBER TAD I X10 /GET SYM NUMBER DCA TEMP2 CDF TAD (STRMAX /GIVE IT MAX SIZE DCA TEMP3 JMS IN TOTAL SIZE IN WORDS JMS I (STOSTB JMP I SVSTOR /DOUBLE PRECISION SUBTRACT SUB, 0 TAD SUBLO /SUBTRACT LOWER CLL CML CIA TAD FREELO DCA FREELO RAL /GET BORROW TAD SUBHI CIA TAD FREEHI /SUBTRACT UPPER DCA FREEHI /SAVE NEW UPPER TAD (BRTND1 /SEE IF ABOVE BRTS FIELD 1 SECTION CLL CIA TAD FREELO /DOUBLE WORD COMPARE STA RAL TAD FREEHI SMA CLA /WILL IT FIT? JMP I SUB /YUP DCA LINEH /CLEAR LINE NUMBER DCA LINEL JMS I (ERMSG /WRITE MESSAGE TBMSG /TOO BIG JMP I (ABORTL /ABORT RUN /CHECK LABEL FOR UNDEFINED CHKLBL, 0 TAD I CHKLBL /GET FIELD DCA .+1 HLT TAD I TEMP2 /GET FIRST WORD OF LABEL SPA CLA JMP I CHKLBL /SIGN BIT IS DEFINED CLL CMA RAL /GET ADDR OF LINE NUM TAD TEMP2 DCA XLABEL TAD I XLABEL /GET HIGH ORDER LINE DCA LINEH ISZ XLABEL TAD I XLABEL /GET LOW ORDER DCA LINEL CDF JMS I (ERMSG /PRINT MESSAGE USMSG JMP I CHKLBL /RETURN PAGE /SYMBOL TABLE SETUP STSTUF, TAD FREELO /SAVE START OF RESIDENT -1 CIA /NEGATED DCA RESADR /USED TO COMPUTE AMOUNT OF MOVE TAD VARCNT /GET NUMBER OF TAD (401 /VARIABLES CIA DCA VARCNT TAD SVCNT /STRING VARIABLES TAD (401 CIA DCA SVCNT TAD ACNT /ARRAYS TAD (41 CIA DCA ACNT TAD SACNT /AND STRING ARRAYS TAD (41 CIA DCA SACNT JMS I (FREEF /SAVE HIGH FIELD DCA STCDF TAD VARCNT /SUBTRACT SPACE FOR CLL RAL /SCALAR TABLE (3 WORDS A PIECE) TAD VARCNT TAD FREELO /DON'T BOTHER WITH A DCA FREELO /DOUBLE PREC. SUBTRACTION TAD FREELO /SAVESVSTOR /ALOOCATE IT JMP STMLUP /LOOP /MAKE ENTRY FOR STRING VARIABLE SVSTOR, 0 TAD TEMP2 /FIND ST ADDR CLL RAL TAD TEMP2 TAD SSTADR DCA X11 TAD TEMP3 /NUMBER OF CHARS JMS I (CVT3F2 DCA SUBLO /NUMBER OF WORDS DCA SUBHI JMS SUB /FREEHI,LO=FREEHI,LO-SUBHI,LO TAD FREELO /SAVE ADDR JMS I (STOSTB JMS I (FREEF /AND FIELD JMS I (STOSTB TAD NWORDS /PUT SNA JMP NONL /NO MORE NUMERIC LITERALS TAD (-1 DCA X10 LFLD, CDF 10 TAD I X10 /GET ADDR OF NEXT LITERAL DCA TEMP P2, TAD I X10 /ALSO ITS FIELD DCA LFLD TAD I X10 /NOW ITS VALUE DCA WORD1 TAD I X10 DCA WORD2 TAD I X10 DCA WORD3 TAD I X10 /NOW THE SYMBOL NUMBER DCA TEMP2 TAD TEMP2 /TIMES THREE CLL RAL TAD TEMP2 TAD FREELO /PLUS START DCA X11 /GIVES STORE ADDR TAD WORD1 /NOW PUT LITERAL INTO TABLE JMS I (STOSTB TAD WORD2 JMS I (STOSTB TAD WORD3 JMS I (STOSTB JMP NLLOOP /DO NEXT LITERAL NONL, TAD ACNT /ALLOCATE ARRAY TABLE CLL RAL CLL RAL /FOUR WORDS PER TAD FREELO /SUBTRACT FROM LOWER END DCA FREELO TAD FREELO /SAVE THIS DCA NASTAD /START OF ARRAY TABLE TAD SVCNT /ALLOCATE CLL RAL /STRING VAR TABLE TAD SVCNT TAD FREELO /3 WORDS EACH DCA FREELO TAD FREELO /AND SAVE IT FOR THE INT DCA SSTADR TAD SACNT /NOW SPACE FOR STRING CLL RAL /ARRAY CLL RAL TAD FREELO /TABLE DCA FREELO TAD FREELO /SAVE FOR INT DCA SASTAD JMP I (DODATA /Do the data now NODATA, CDF 10 /PREPARE TO MOVE P3, TAD I (SLITRL+1 DCA SLFLD /STRING LITERALS TAD I (SLITRL CDF SKP SLLOOP, TAD TEMP /IS NEXT LIT THERE ? SNA JMP I (NOSL /NO, END OF THE LINE TAD (-1 DCA X10 JMS SFLD /SET THE FIELD TAD I X10 /GET ADDR OF NEXT DCA TEMP P4, TAD I X10 /ALSO FIELD DCA TEMP2 TAD I X10 /THEN CHAR COUNT DCA NCHARS JMP I (SLIT2 /DO REST OF STRING LIT SFLD, 0 SLFLD, CDF 10 JMP I SFLD PAGE SLIT2, TAD NCHARS /COMPUTE WORD CO START OF SCALAR TABLE IAC /FOR INTERPRETER DCA NSTADR TAD FREELO /CLEAR ALL VARIABLES DCA X11 /IN THE JMS I (STOSTB /SCALAR TABLE JMS I (STOSTB JMS I (STOSTB ISZ VARCNT JMP .-4 /JUST TO BE NICE CDF 10 /PREPARE TO MOVE P1, TAD I (LITRL+1/THE NUMERIC LITERALS DCA LFLD /INTO THE SCALAR TABLE TAD I (LITRL CDF SKP NLLOOP, TAD TEMP /ADDR OF NEXT LITERAL3 JMP MOVSL P5, TAD TEMP2 /PUT THE FIELD OF THE NEXT DCA I (SLFLD /ENTRY WHERE IT DOES THE MOST GOOD JMP I (SLLOOP /DO THE NEXT LITERAL /HANDLE DATA NOW DODATA, TAD FREELO /SAVE TOP OF DATA LIST DCA DATTOP TAD DATTOP /IF EMPTY MAKE TOP=BOTTOM DCA DATPTR TAD DLSIZE SNA /IS ANY DATA ? JMP I (NODATA /NO CLL TAD FREELO /GET START OF DATA DCA FREELO SNL JMP TMDATA /TOO MUCH DATA / TAD FREELO / TAD (-END-10 / SZL CLA / JMP TMDATA /DITTO TAD FREELO /SAVE IT DCA DATPTR TAD FREELO /USE X11 TO FILL LIST DCA X11 TAD (DATLST-1 DCA X10 CDF 10 DATLUP, TAD I X10 /ANY MORE DATA ELEMENTS ? SNA JMP I (NODATA DCA TEMP /SAVE ADDR P8, TAD I X10 /GET NEW FIELD DCA DATAF1 P9, TAD DATAF1 /TWICE DCA DATAF2 TAD TEMP /START WITH NEW ELEMENT DCA X10 DATAF1, CDF 10 TAD I TEMP /GET COUNT DCA TEMP DATMOV, TAD I X10 /GET NEXT WORD JMS I (STOSTB /MOVE INTO DATA AREA DATAF2, CDF 10 ISZ TEMP JMP DATMOV JMP DATLUP /DO NEXT ELEMENT TMDATA, DCA LINEL /ZERO LINE NUMBER DCA LINEH JMS I (ERMSG /PRINT ERROR MESSAGE TDMSG JMP I (ABORTL PAGE /HANDLE NUMERIC ARRAYS ALLOCA, TAUNT JMS I (CVT3F2 TAD X10 /TO GET ADDR OF SYMBOL NUMBER DCA TEMP3 TAD I TEMP3 CLL RAL /SYM NUMBER TIMES 3 TAD I TEMP3 TAD SSTADR /PLUS BASE DCA X11 /GIVES ST ADDR TAD NWORDS /GET NUMBER OF WORDS CIA DCA TEMP3 /(SAVE NUMBER OF WORDS) TAD NWORDS /Check if room DCA SUBLO DCA SUBHI JMS I (SUB /Do double precision subtract TAD FREELO /Set pointer for move DCA PUTLOC JMS I (FREEF /And the field CDF 0 DCA I (PUTCDF TAD FREELO /STICK THE ADDR IAC JMS I (STOSTB /INTO THE ST ENTRY JMS I (FREEF /ALSO THE FIELD JMS I (STOSTB TAD NWORDS /ALSO THE SIZE IN WORDS JMS I (STOSTB TAD NCHARS /PUT IN THE LENGTH TOO CIA /(NEGATIVE) JMP .+3 MOVSL, JMS I (SFLD TAD I X10 JMS I (PUTWD /MOVE THE LITERAL TEXT ISZ TEMPALSO DIMS JMS I (STOSTB TAD TEMP3 JMS I (STOSTB ISZ X10 /SKIP SYMBOL NUMBER ISZ ACNT JMP DOARAY /HANDLE STRING ARRAYS ALLOCS, TAD SACNT /ANY STRING ARRAYS SNA CLA JMP I (RELCIT /NO TAD (SARYST+1 DCA X10 /ALLOCATE STRING ARRAYS TAD SASTAD DCA X11 DOSARY, CDF 10 TAD I X10 SNA TAD (12 /USE 10 FOR DIM IAC DCA TEMP3 TAD I X10 /GET DIM SNA TAD (STRMIN /USE DEFAULT IF NO SIZE SPEC DCA TEMP2 TAD TEMP3 DCA SUBLO /PREPARE FOR MULT DCA SUBHI CDF TAD TEMP2 /GET NUM WORDS PER STRING JMS I (CVT3F2 JMS I (MUL12 /GET ARRAY SIZE JMS I (SUB /DO SUBTRACTION TAD FREELO /SAVE ADDR JMS I (STOSTB JMS I (FREEF JMS I (STOSTB TAD NWORDS /AND SIZE IN WORDS JMS I (STOSTB TAD TEMP3 /AND NUMBER OF STRINGS JMS I (STOSTB ISZ X10 /SKIP NEXT NAME ISZ X10 /AND NEXT SYM NUMBER ISZ SACNT JMP DOSARY JMP I (RELCIT /READ FROM THE CODE FILE INWORD, 0 ISZ ICOUNT /ANYTHING IN BUFFER JMP NOREAD /YASSUH! (Spreak Ingresh troop!) JMS I (7607 /READ NEXT BLOCK 210 INBUF INBLOK, 0 JMP I (IOERR ISZ INBLOK /BUMP BLOCK COUNTER TAD INBLOK-1/RESET BUFFER POINTER DCA INPTR D ACNT /ANY ARRAYS ? SNA CLA JMP ALLOCS /NO TAD (ARAYST /ALLOCATE ARRAYS DCA X10 TAD NASTAD DCA X11 DOARAY, CDF 10 TAD I X10 /GET NEXT ARRAY DCA TEMP TAD I X10 /GET FIRST DIM SNA TAD (12 /USE 10 IF NONE IAC /ALLOCATE 0TH ELEMENT DCA TEMP2 TAD I X10 /GET SECOND DIM SNA TAD (12 IAC DCA TEMP3 TAD TEMP3 /GET READY TO SUBTRACT DCA SUBLO DCA SUBHI CDF CLL CML RTR AND TEMP /HOW MANY DIMS ? SNA CLA JMP ONLY1 /ONE TAD TEMP2 /PRODUCT OF DIMS JMS I (MUL12 JMP TIMES3 /MULT BY 3 ONLY1, DCA TEMP3 /ZERO SECOND DIMENSION TAD TEMP2 DCA SUBLO TIMES3, TAD (3 /MULT SIZE BY 3 JMS I (MUL12 JMS I (SUB /SUBTRACT FROM FREE TAD FREELO JMS I (STOSTB /SAVE ADDR IN S.T. JMS I (FREEF JMS I (STOSTB TAD TEMP2 / TAD OUTFLG /SEE IF BCOMP DID ANY WRITES TO TEMP FILE SNA CLA /SKP IF YES, FORCE READ AND WRITE TAD (400 /ELSE SET COUNT TO USE STUFF IN BUFFER AS IS CMA DCA ICOUNT TAD CODBGN /COMPARE LOWEST CORE LOC USED BY CODE-1 CLL CIA TAD NEXT /TO HIGHEST S.T. ADDR USED CLA CML RAL TAD I (PUTCDF /CODE CDF CIA TAD FREFLD /S.T. CDF PASSED BY BCOMP SPA CLA /SKP IF CODE LOWER THAN SYMBOL TABLE END TAD (PUTWD-OUTWRD /ELSE WE CAN STORE DIRECTLY AND SAVE SOME I/O TAD (OUTWRD DCA QOUTWRD /SET THE PROPER OUTPUT ROUTINE POINTER RELOOP, JMS I (INWORD /GET A WORD OF CODE DCA TEMP TAD (-5000 TAD TEMP /CHECK FOR OPCODE 5000 (GOTO) AND (7400 SZA CLA JMP NORELC /NO JUMP TAD TEMP /REMOVE FIELD BITS AND (340 CLL RTR TAD CDF0 DCA LBL TAD (-400 /AND COUNTER DCA ICOUNT NOREAD, CDF 10 TAD I INPTR /GET WORD CDF ISZ INPTR /BUMP POINTER JMP I INWORD INPTR, INBUF PAGE /Relocate GOTO/GOSUB addresses now /In order to minimize I/O we use the code in the BCOMP output /buffer directly if no more than 1 bufferfull is used. /In addition, a test is made if the code will fit above the BCOMP /Symbol Table, and if so code is stored directly instead of passing /through the temp file first. RELCIT, DCA I (PUTWD /Clear 'loaded' flag TAD LOCTRL /FIND START OF CODE CLL IAC DCA SUBLO /BY SUBTRACTING RAL TAD LOCTRH /AMOUNT FROM FREE DCA SUBHI JMS I (SUB TAD FREELO /THIS IS THE START OF THE CODE DCA CODBGN /MINUS ONE TAD FREEHI /THIS IS THE FIELD NUMBER DCA CODCDF TAD CODBGN /SET UP CODE STORE ROUTINE DCA PUTLOC /STARTING ADDR-1 TAD CODCDF CLL RTL RAL TAD (6201 DCA I (PUTCDF /STARTING CDF TAD LOCTRL /SET UP PROG SIZE COUNT CLL CML CIA DCA CODSZ1 /LOWER COUNT RAL TAD LOCTRH CIA DCA CODSZ2 /UPPER COUNT TAD BLOCK /SET UP FOR READ AND WRITE DCA I (OUBLOK TAD BLOCK DCA I (INBLOK TAD (-401 DCA OCOUNT UDUMP /DUMP LAST BLOCK TAD LOCTRL /SET UP COUNTER CIA CLL CML DCA CODSZ1 RAL TAD LOCTRH CIA DCA CODSZ2 DCA I (INPTR /ASSUME OUTPUT BUFFER USABLE AS IS TAD I (OUDUMP /TEST IF TEMP FILE WRITES DONE SNA CLA /SKP IF YES TAD (400 /ELSE SET COUNT TO ALLOW READ FROM BUFFER AT ONCE CMA /FORCE NORMAL READ IF MORE THAN ONE BUFFERFULL DCA ICOUNT /STORE THE INPUT COUNT TAD BLOCK /SET UP BLOCK NUMBER DCA I (INBLOK LODLUP, JMS I (INWORD /GET A WORD FROM TEMP FILE (OR BUFFER) JMS PUTWD /PUT IN CORE NOW ISZ CODSZ1 /MORE CODE ? JMP LODLUP /YES ISZ CODSZ2 JMP LODLUP /YES LOADED, TAD CODCDF /SETUP CODE CDF CLL RTL RAL TAD CDFZER DCA CODCDF CLRLUP, TAD CLREND /IS THIS THE END OF CLEAR ? TAD PUTLOC SZA CLA JMP MORCLR /NFLD /FIELD OF LABEL ENTRY TAD TEMP /ZERO FIELD BITS AND (7437 DCA TEMP JMS I (INWORD /GET REST OF ADDR DCA TEMP2 JMS I (CHKLBL /CHECK FOR UNDEFINED LABEL LBLFLD, HLT TAD I TEMP2 AND (7 /GET ADDR TO BE RELOCATED DCA LOCHI ISZ TEMP2 TAD I TEMP2 CLL TAD CODBGN /ADD BASE ADDR CDF0, CDF DCA LOCLO /SAVE LOW PART OF JUMP RAL TAD CODCDF /GET HIGH PART TAD LOCHI CLL RTL /PUT IT INTO CORRECT PLACE RTL RAL TAD TEMP /PLUS INSTRUCTION JMS I QOUTWRD ISZ CODSZ1 /BUMP COUNTER SKP ISZ CODSZ2 /CAN'T BE LAST WORD TAD LOCLO /OUTPUT LOW ORDER ADDR SKP NORELC, TAD TEMP /JUST OUTPUT IT RELOUT, JMS I QOUTWRD ISZ CODSZ1 /DOUBLE WORD ISZ BUMP JMP RELOOP ISZ CODSZ2 JMP RELOOP JMP I (LOADIT /DONE RELOCATING, GO LOAD /PRINT ERROR MESSAGE ERMSG, 0 /PRINT ERROR MESSAGE CDF TAD I ERMSG /GET CODE ISZ ERMSG CIF CDF 10 JMS I (XERMSG /CALL FIELD 1 ERROR MESSAGE PRINTER JMP I ERMSG PAGE LOADIT, TAD PUTWD /SEE IF CODE IS ALREADY LOADED SZA CLA /SKP IF NO JMP LOADED /ELSE SKIP READ AND LOAD TAD I (OUDUMP /TEST IF OUTPUT BUFFER WRITTEN SZA CLA /SKP DUMP IF YES JMS I (OINI, TAD I (ERMSG /ANY ERRORS ? SZA CLA JMP ABORT /YES, DON'T RUN IT TAD BRTS /READ IN BRTS FIELD 1 SECTION DCA BRTSB JMS I (7607 BRTSZ1+10 BRTLD1 /INTO HERE BRTSB, 0 JMP IOERR CIF 10 /NOW JMS TO FIELD 1 STARTUP CODE TAD BRTSB /PASS STARTING BLOCK OF BRTS IN AC JMS I (BRTBG1 STCDF /CALL+1 CONTAINS ADDR OF BRTS PARAMETERS IOERR, DCA LINEL /ZERO LINE NUMO, KEEP GOING TAD CLRFLD /DO FIELDS MATCH ? TAD PUTCDF SNA CLA JMP DONCLR /YES, ARRAYS ARE CLEARED MORCLR, JMS PUTWD JMP CLRLUP DONCLR, JMS MOVFIN /MOVE FINI PAGE INTO 7000-7177 JMP I (7000 /GO READ BRTS.SV /BUMP POINTER AND STORE WORD IN CORE PUTWD, 0 ISZ PUTLOC /PRE INCREMENT POINTER JMP PUTCDF /JMP IF FIELD NOT CROSSED DCA PUTTMP /SAVE WORD TAD PUTCDF /PROPAGATE CARRY INTO CDF TAD (10 DCA PUTCDF TAD PUTTMP /GET WORD BACK PUTCDF, HLT DCA I PUTLOC CDF JMP I PUTWD PUTTMP, 0 /MAKE A CDF FROM FREEHI FREEF, 0 TAD FREEHI CLL RTL RAL TAD CDFZER JMP I FREEF ABORTL, JMS MOVFIN /PUT FINI PAGE INTO 7000-7177 /AND ABORT THE RUN JMP I (ABORT-FINI+7000 MOVFIN, 0 /FINI PAGE MOVER CDFZER, CDF TAD (FINI-1 /MOVE INT READING CODE DCA X10 TAD (6777 /INTO 7000 DCA X11 TAD (-200 DCA TEMP /PUT CORRECT COUNT HERE TAD I X10 DCA I X11 /MOVE CODE ISZ TEMP JMP .-3 JMP I MOVFIN /Large core image save problem fix PATCHI, CLA STL RTL /TEST IF ABOUT TO SAVE FIELD 1 OR 2 TAD I (FLDCNT&177+200 CLL RAR SZA CLA JMP FLDN /JMP IF NOT FIELD 1 OR 2 SZL /LINK ON IF FIELD 1 JMP FLD1 /JMP IF FIELD 1 TO LEAVE LAST PAGE ALONE TAD I (TDFLAG&177+200 /IF FIELD 2, TEST IF 2 PAGE SYSTEM HANDLER SZA CLA /SKP IF NOT 2 PAGE SYSTEM HANDLER, 27600 IS USED FLD1, TAD (3700 FLDN, TAD TEMP JMP I (RETN&177+200 PAGE /ROUTINES AT START OF THIS PAGE ARE RELOCATED BY "MOVFIN" /TO *7000 JUST PRIOR TO EXECUTION (EDITOR OVERLAYS HERE, ETC) FJMS I (7607 /WRITE BLOCK 4210 0 OUBLOK, 0 JMP IOERR JMP I OUDUMP /CONVERT CHAR COUNT TO NUMBER OF 3/2 WORDS+1 /CALCULATES 1+INT(2*(N+1)/3) CVT3F2, 0 CLL IAC /CALCULATE 2*(N+1) CLL RAL /LEAVE A CLEAR LINK DCA AC1 TAD (-10 /SET FOR 8 STAGE SUBTRACT-SHIFT DIVIDE DCA SC TAD AC1 /GET 2*(N+1) CVTLP, STL TAD (4000-600 SMA /SIGN BIT COMPLEMENTS IF WENT BER JMS I (ERMSG /PRINT MESSAGE IOMSG ABORT, TAD (20 /PASS FIELD BITS TO RESTORE HANDLER CIF/CDFS JMS I (SWAP /SWAP OS8 BACK TAD (4207 /NOW REMOVE ^C HOOKS FROM SYS: DCA I (7600 TAD (6213 DCA I (7605 JMS I (200 /CHECK OUT W/ CI BUILDER (RELOCATED MAKECI ROUTINE) TAD ABORTX /CALLED VIA CHAIN ?(FROM EDIT) SNA JMP I (7600 /NO, RETURN TO OS8 DCA EDTBLK /YES, SAVE EDITOR START JMS I (7607 /READ IN EDITOR EDTSIZ /THIS MUCH 0 OWTEMP, EDTBLK, 0 JMP I (7605 /ERROR JMP I (EDTBGN /GO START EDITOR /FOLLOWING ROUTINES EXECUTE IN THIS PAGE NORMALLY /MULTIPLY 12 BITS AND 24 BITS MUL12, 0 DCA AC3 /SAVE 12 BIT THING DCA AC2 /CLEAR REST OF AC DCA AC1 TAD (-15 /ONLY TEST 12 BITS DCA SC JMP MULBGN MULLUP, SNL /WAS BIT ON ? JMP NOADD /NO, DON'T ADD TAD SUBLO /ADD TO HIGH ORDER 2/3'S OF AC TAD AC2 DCA AC2 CML RAL TAD SUBHI NOADD, TAD AC1 /SHIFT AC RIGHT CLL RAR DCA AC1 TAD AC2 RAR DCA AC2 MULBGN, TAD AC3 FTEMP, RAR FTEMP2, DCA AC3 FCNT, ISZ SC /BUMP SHIFT COUNTER JMP MULLUP TAD AC2 /ANSWER IS LOWER 2/3'S OF AC DCA SUBHI TAD AC3 DCA SUBLO JMP I MUL12 /OUTPUT WORD TO TEMP FILE OUTWRD, 0 ISZ OCOUNT /ANY ROOM ? JMP NOWRIT /YES DCA OWTEMP /SAVE WORD JMS OUDUMP /WRITE BLOCK ISZ OUBLOK /BUMP BLOCK NUMBER TAD OUBLOK-1/RESET BUFFER POINTER DCA OUPTR TAD (-400 DCA OCOUNT /AND COUNT TAD OWTEMP /RESTORE AC NOWRIT, CDF 10 DCA I OUPTR /INTO BUFFER CDF ISZ OUPTR JMP I OUTWRD OUPTR, 0 OUDUMP, 0 /WRITE BLOCK IN TAD (4000+600 /RESTORE AND COMPLEMENT OTHERWISE RAL /SHIFT IN QUOT BIT AND DISCARD SIGN BIT ISZ SC JMP CVTLP /ITERATE AND (377 /NOW MASK OUT REMAINDER IAC /ALLOW FOR SIZE WORD DCA NWORDS /SAVE THE TOTAL SIZE TAD NWORDS /RETURN IT IN AC JMP I CVT3F2 /--RETURN-- END=FINI+200 PAGE /ROUTINE USED TO INITIALIZE LOADER IMAGE, 0 TAD (ABORTL /MODIFY ^C HOOK POINTER FOR BLOAD TRAP ROUTINE DCA BABORT JMS I (ERMOVE /SHUFFLE ERROR MESSAGE PRINTER TO FIELD 1 CDF 10 TAD I (INFO+2 /GET STARTING BLOCK OF BLOAD TAD (OVSEP /OFFSET TO BLOAD OVERLAY CDF DCA I (LDRBLK /STORE INLINE CDF 10 TAD I (CDOPT4 /GET OPTION BITS [MNO PQR STU VWX] CDF AND (4 /TEST FOR /V SZA CLA JMS I (VERNUM /JMS IF YES TO EXHIBIT BLOAD VERSION CDF 10 TAD I (CDOPT3 /GET OPTION BITS [ABC DEF GHI JKL] CDF AND (40 /TEST IF /G SET SZA CLA /SKP IF NO, COMPILE ONLY JMP LSTART /ELSE START LOADER NOW TAD HIFLD CIA DCA I (FLDCNT /INIT CI BUILDER TAD I (FLDCNT DCA I (MYCORE /AND CI STARTER CDF 10 DCA I (CDOPT6 /CLEAR =N BITS DCA I (CDOPT3 /AND EARLY OPTIONS TAD I (CDOPT4 /GET OPTION BITS [MNO PQR STU VWX] CDF RTL SZL CLA /HAVE N SWITCH? JMP NOTDSY /DISALLOW RUNNING ON 2 PAGE SYSTEM HANDLER SYSTEM IF YES TAD HIFLD CLL RAR SNA CLA /SKP IF OVER 8K CORE JMP NOTDSY /ELSE JMP AROUND EXTRA PAGE ALLOCATION DCA I (GOTTD /FORCE EXTRA PAGE CLA IAC /FLAG THE EXTRA PAGE NOTDSY, DCA I (TDFLAG CMA DCA I (ERMSG /FORCE LOAD ABORT LSTART, TAD (BLDCI-1 /MOVE CI BUILDER DCA X10 /INTO LOW CORE TAD (MAKECI-1 DCA X11 TAD I X11 DCA I X10 ISZ ICTR JMP .-3 TAD HIFLD /START OF BLOAD V1 DCA FREEHI JMP I IMAGE /RETURN TO LOADER ICTR, -200 PAGE CCB=1000 /LOC TO START BUILDING CCB MAKECI, 0 /THIS PAGE GETS MOVED TO *200 NOP /NOP'D FOR VT278 NOP /NOP'D FOR VT278 ISZ I (ERMSG /WHY ARE WE HERE? JMP BOSFIX /GENUINE ABORTION TAD (CCB-1 /INITIALIZE FIRST 4 WORDS OF CCB DCA X10 DCA I X10 /ZERO SEGMENT COUNT TAD (CIF CDF /SET CIF CDF ENTRY POINT DCA I X10 TAD PCISTRT /ENTRY ADDR DCA I X10 TAD (1000 /JSW BITS DCA I X10 / TAD TDFLAG /TEST IF SPACE ALLOCATED FOR 2 PAGE SYSTEM HANDLER / SZA CLA /SKP IF NO / TAD (3700 /SET FLAG TO DECREMENT HIGHEST CCB FIELD SEGMEMT 1 PAGE / DCA HIDECR / IF YES CCSEGS, TAD FLDCNT /GET MINUS CURRENT FIELD CIA /MAKE POSITIVE CLL RAL /SHIFT TO AC6-8 RTL DCA TEMP /SAVE TAD CODCDF /GET FIELD BITS OF LOWEST FIELD USED AND (70 CLL CIA TAD TEMP /COMPARE TO CURRENT FIELD SNL /SKP IF CURRENT FIELD GE LOWEST FIELD JMP NOCODE /ELSE FIELD IS UNUSED SZA CLA /SKP IF LOWEST FIELD JMP ALLCODE /JMP IF NOT, SAVE WHOLE FIELD TAD CODBGN /ISOLATE BLOCK BITS IN AC0-3 AND (7400 DCA TEMP2 /SAVE THEM TAD TEMP2 /FORM POSITIVE PAGE COUNT CIA CLL RAR /IN AC1-5 TAD TEMP /ADD TO FIELD BITS DCA TEMP TAD TEMP2 /PICK UP START OF BLOCK IN CORE ALLCODE,DCA I X10 /STORE THE SEGMENT STARTING ADDR TAD TEMP /PICK UP PAGE COUNT/FIELD WORD / TAD HIDECR /DECREMENT PAGE COUNT IF SECOND SYS HANDLER PAGE ALLOCATED / AND (3777 /MASK OUT SIGN BIT JMP I (PATCHI RETN, AND (3777 /MASK OUT SIGN BIT DCA I X10 /NOW STORE PAGE COUNT/FIELD WORD / DCA HIDECR /ZERO OUT THE HIGH FIELD FLAG ISZ I (CCB /TALLY THE SEGMENT NOCODE, CLA CLL ISZ FLDCNT /NEXT FIELD ZERO? JMP CCSEGS /NO: LOOP TAD PCISTRT /STORE ADDR OF OUR STARTUP CODE DCA I X10 TAD O300 /NOW THE PAGE COUNT/FIELD WORD DCA I X10 TAD I (CCB CMA DCA I (CCB /NEGATE SEG COUNT JMS I (7607 /READ CI STARTER O300, 300 /FROM END OF BLOAD.SV PCISTRT,CISTRT /INTO HI CORE LDRBLK, 0 /INIT BY "IMAGE" HLT /CRASH SYS ON ERROR HERE TAD (1000 /SET THE JSW NON RESTARTABLE NOW! DCA I (JSW TAD TDFLAG /PASS 2 PAGE SYSTEM HANDLER FLAG DCA I (FLAGTD TAD MYCORE DCA I (NOCO, 1 /ZERO IF BIG SYSTEM HANDLER ILLEGAL AT RUNTIME /NONZERO IF SPACE WAS ALLOCATED FOR IT MYCORE, 0 /HIDECR,0 /SET TO 3700 TO DECREMENT PAGE COUNT OF HIGHEST / /MEMORY FIELD USED FOR 2 PAGE SYSTEM HANDLERS /RESTORE BATCH STATE AND EXIT IF ANY COMPILE ERROR BOSFIX, TAD I (JSW /TEST IF BATCH WAS UNTOUCHED AND (400 SNA CLA /SKP IF YES, NO NEED TO RESTORE BATCH STATE TAD I (BIPCCL RAL SMA CLA JMP I MAKECI /BATCH NOT RUNNING TAD I (BIPCCL AND (70 TAD CDFZRO DCA BOSCDF /CDF TO BATCH FIELD BOSLUP, CDF 10 TAD I BOSPT1 /GET BATCH WRDS BOSCDF, HLT DCA I BOSPT2 /BACK INTO POSITION CDFZRO, CDF ISZ BOSPT1 ISZ BOSPT2 JMP BOSLUP JMP I MAKECI BOSPT1, 7600 BOSPT2, 7774 PAGE /ENTRY ADDR FOR .R BLOAD JUST PRINTS VERSION NUMBER AND EXITS TLS TSF JMP .-1 CLA CLL JMS VERNUM /PRINT THE VERSION JMP I (7605 /RETURN TO OS/8 /PRINT VERSION VERNUM, 0 TAD (VTEXT DCA TEMP MOREV, TAD I TEMP SNA JMP VOUT CLL RTR RTR RTR JMS TTY TAD I TEMP JMS TTY ISZ TEMP JMP MOREV VOUT, TAD (15 JMS TTX TAD (12 JMS TTX JMP I VERNUM VTEXT, TEXT /BLOAD V / *.-1 VERLOC, VERSON^100+PATCH 0 TTY, 0 TAD (40 AND (77 TAD (40 JMS TTX JMP I TTY TTX, 0 TLS TSF JMP .-1 CLA JMP I TTX /ONCE ONLY ROUTINE TO MOVE ERROR MESSAGE PRINTER TO FIELD 1 ERMOVE, 0 ERLUP, TAD I ERAD1 CDF 10 DCA I ERAD2 CDF ISZ ERAD1 ISZ ERAD2 ISZ ERCNT JMP ERLUP JMP I ERMOVE ERAD1, ERLOC0 ERAD2, XERMSG ERCNT, -400 PAGRE /AND CORE LIMIT TAD (STCDF-1 /SAVE 10 KEY LOCATIONS DCA X10 TAD (KEYLOC-1 DCA X11 TAD I X10 DCA I X11 ISZ MCICNT JMP .-3 JMS I (7607 /CALL SYS HANDLER 4200 /TO WRITE CCB CCB-200 /(AND PRECEDING PG) 37 /INTO SCRATCH BLOCK HLT /CRASH SYSTEM ON ERROR HERE JMP I (7600 /FINAL SUCCESSFUL EXIT TO OS/8 -- IMAGE IS LOADED MCICNT, -12 FLDCNT, -7 TDFLAGIGNORES LINE 0) JMS SCRIBE /WRITE "at Line" ATLINE CDF DCA SPCH /Clear leading zero flag TAD I (LINEH /PRINT HIGH ORDER DIGITS JMS PSN CDF TAD I (LINEL /PRINT LOW ORDER DIGITS JMS PSN NOLINO, TAD (15 /NOW PRINT CR,LF JMS SPCH TAD (12 JMS SPCH CIF CDF /RETURN TO FIELD 0 JMP I XERMSG SCRIBE, 0 TAD I SCRIBE /GET MESSAGE ADDR ISZ SCRIBE DCA MSGPTR SCRLP, TAD I MSGPTR SNA /SKP IF NOT EOM JMP I SCRIBE /ELSE EXIT JMS SPCH ISZ MSGPTR JMP SCRLP MSGPTR, 0 SPCH, 0 TLS TSF JMP .-1 CLA JMP I SPCH PSN, 0 CDF 10 DCA LWORD /SAVE LINE NUMBER WORD AC7775 /DO 3 DIGITS DCA LCNTR / DCA SPCH /CLEAR LZ SWITCH PSNLP, TAD LWORD /SHIFT NEXT DIGIT UP RTL RTL DCA LWORD TAD LWORD RAL AND (17 SZA JMP NOZERO /PRINT IT IF NONZERO TAD SPCH /ANY PREV DIGITS SNA CLA JMP LEAD0 /NO, IGNORE IT NOZERO, TAD (60 JMS SPCH /OUTPUT DIGIT LEAD0, ISZ LCNTR JMP PSNLP JMP I PSN LWORD, 0 LCNTR, 0 ATLINE, ":;" ;0 PAGE UFMSG, "U;"n;"c;"l;"o;"s;"e;"d;" ;"F;"O;"R;"-;"N;"E;"X;"T;" ;"L;"o;"o;"p;0 TBMSG, "P;"r;"o;"g;"r;"a;"m;" ;"t;"o;"o;" ;"b;"i;"g;" ;"t;"o;" ;"r;"u;"n;0 TDMSG, "T;"o;"o;" ;"m;"u;"c;"h;" ;"D;"A;"T;"A;0 USMSG, "U;"n;"d;"e;"f;"i;"n;"e;"d;" ;"L;"i;"n;"e;" ;"N;"u;"m;"b;"e;"r;0 IOMSG, "I;"/;"O;" ;"E;"r;"r;"o;"r;" ;"o;"n;" ;"S;"Y;"S;":;0 PAGE RELOC /MAIN ENTRY POINT FOR PRE COMPILED PROGRAMS *7000 CISTRT, JMP RUNNED /JMP IF DIRECT RUN CDF 10 /ELSE SEE IF BRTS PASSED MAGIC = OPTION TAD I (CDOPT2 /IN HIGH ORDER BITS E ERLOC0, RELOC XERMSG /ERROR MESSAGE PRINTER /EXECUTES (IF AT ALL) IN FIELD 1 IN BCOMP TEMP FILE OUTPUT BUFFER XERMSG, 0 DCA EADDR /STORE MESSAGE POINTER PASSED IN AC TAD (77 /FIRST PRINT "?" JMS SPCH JMS SCRIBE /WRITE IT EADDR, 0 CDF TAD I (LINEH /SEE IF LINE NUMBER PRESENT SNA TAD I (LINEL CDF 10 SNA CLA JMP NOLINO /JMP IF NO, DON'T PRINT IT (/TAKE ERROR EXIT 1 /INCOMPLETE SYSTEM USROUT, CIF 10 JMS I (200 11 /USR OUT JMP I (CHAIN /JMP TO CONTINUE STARTUP PROCESSING NAMLST, BCOMPN;0 /NOTE THAT BRTS MUST CHECK FOR BOTH BLOADN;0 /BCOMP AND BLOAD BEFORE ATTEMPTING A CHAIN TO BCOMP BRTSN;-1 BOVN;-1 0 BRTSN, FILENAME BRTS.SV BOVN, FILENAME BASIC.OV BCOMPN, FILENAME BCOMP.SV BLOADN, FILENAME BLOAD.SV CORE, 0 TAD I (BIPCCL AND COR70 CLL RAR RTR SZA /IS THERE A SYSTEM VALUE? JMP I CORE /YES: USE IT COR0, CDF TAD CORSIZ RTL RAL AND COR70 TAD COREX DCA .+1 COR1, CDF TAD I CORLOC COR2, NOP DCA COR1 TAD COR2 DCA I CORLOC COR70, 70 TAD I CORLOC CORX, 7400 TAD CORX TAD CORV SZA CLA JMP COREX TAD COR1 DCA I CORLOC ISZ CORSIZ JMP COR0 COREX, CDF CLA CMA /HI FIELD IS #FIELDS-1 TAD CORSIZ JMP I CORE CORLOC, CORX CORV, 1400 CORSIZ, 1 PAGE /CONTINUATION OF SAVE IMAGE STARTUP CHAIN, CDF 10 DCA I (CDOPT2 DCA I (CDOPT3 /ZERO OUT CD OPTION BITS DCA I (CDOPT4 DCA I (CDOPT5 TAD I (INFO+3 /GET BRTS START BLOCK FROM INFORMATION AREA CDF DCA BRTSST /STORE INLINE JMS I (7607 /NOW READ TAD (-MAGIC SNA CLA /SKP IF NO, DO FULL BASIC SYSTEM INITIALIZATION JMP I (CHAIN /JMP IF YES FOR FAST STARTUP RUNNED, TAD (INFO-1 /INITIALIZE SYSTEM INFORMATION AREA ON RUN DCA X10 TAD (NAMLST-1 DCA X11 CDF 10 DCA I X10 /ZERO EDITOR BLOCK NUMBER CDF CIF 10 JMS I (7700 10 /USRIN FINDSV, TAD I X11 /LOOKUP SOME SAVE FILES SNA JMP USROUT /DONE, KICK USR OUT DCA XXXXSV /SAVE POINTER TO NAME CLA IAC /THEY'RE ON SYS CIF 10 JMS I (200 2 XXXXSV, 0 0 JMP NOTFND /JMP IF NOT FOUND ISZ X11 /BUMP TO NEXT FILE TAD XXXXSV /GET STARTING BLOCK IAC /PLUS 1 ZERFIL, CDF 10 DCA I X10 /INTO INFO AREA CDF JMP FINDSV /LOOP NOTFND, ISZ I X11 /SKP IF ESSENTIAL SYSTEM COMPONENT JMP ZERFIL /JMP BACK IF NOT JMS I (ERRORX DCA I SPTR ISZ SPTR JMP SWPLOOP CDF /NOW ADJUST THE HANDLER CIF/CDF'S TO MATCH TAD CDFTOP AND (70 /ISOLATE FIELD BITS DCA CDFTOP ADJLUP, TAD I SPTR0 TAD (-6300 /RANGE CHECK WORD FOR CIF/CDF N0 CLL TAD (70 SNL CLA JMP NOADJ /JMP IF NOT CIF/CDF TAD I SPTR0 /ELSE FIX DF AND (7707 TAD CDFTOP DCA I SPTR0 NOADJ, ISZ SPTR0 JMP ADJLUP /LOOP UP TO END OF FIELD NOT2PG, TAD KEYLOC+SWPINF-STCDF /SET LOW BIT INDICATING 17600 NOT SWAPPED RAR STL RAL DCA KEYLOC+SWPINF-STCDF TAD I (BIPCCL /SEE IF BATCH RUNNING NOW RAL SMA CLA JMP NOBAT /JMP IF NO TAD I (BIPCCL AND (70 /ELSE GET SET TO SAVE BATCH STATE TAD CDFO DCA BATCDF /STORE INLINE BATCDF, HLT TAD I BATAD1 /GET A WORD CDF 10 DCA I BATAD2 /SAVE A WORD ISZ BATAD2 ISZ BATAD1 JMP BATCDF CDFO, CDF NOBAT, TAD BRTSST /PASS STARTING BLOCK OF BRTS IN AC CIF 10 /NOW JMS TO FIELD 1 STARTUP OF BRTS JMS I (BRTBG1 KEYLOC /CALL+1 CONTAINS PTR TO PARAMETER BLOCK FOR BRTS NOCORE, 0 FLAGTD, 1 KEYLOC, ZBLOCK 12 SPTR0, 7635 /POINTER FOR HANDLER FIELD FIXES STMP1, 0 STMP2, 0 SPTR, 7600 BATAD1, 7774 BATAD2, 7600 PAGE /ER FIELD 1 SEGMENT IN BRTSZ1+10 BRTLD1 /INTO HERE BRTSST, 0 JMS I (ERRORX /TAKE ERROR EXIT ON ERROR HERE 4 JMS I (CORE /GET HOST CORE SIZE TAD NOCORE /COMPARE TO REQUIRED CORE SPA CLA /SKP IF HOST GE REQUIRED JMS I (ERRORX /ELSE PRINT USER ERROR MESSAGE 3 AC7775 /NOW SEE IF 2 PAGE SYSTEM HANDLER TAD I (7612 SZA CLA JMP NOT2PG /JMP IF NO TAD FLAGTD /IF YES, SEE IF SPACE ALLOCATED FOR IT SNA CLA JMS I (ERRORX /JMS IF NO TO GIVE ERROR 2 TAD KEYLOC /GET CDF TO HIGH CORE DCA CDFTOP /STORE INLINE SWPLOOP,CDF 20 /SWAP SECOND PAGE OF HANDLER OUT NOW TAD I SPTR DCA STMP1 CDFTOP, HLT TAD I SPTR DCA STMP2 TAD STMP1 /MOVE HANDLER WORD UP TO HIGH FIELD DCA I SPTR CDF 20 TAD STMP2 /MOVE HIGH FIELD WORD TO FIELD 2 /MATH.PA FOR OS78 V4 /ORIGINALLY: /6 MATH: STRING ARITHMETIC FOR BASIC V7A / / / / / / / / / /COPYRIGHT (C) 1978, 1979, 1981 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMROR MESSAGE PRINTER FOR CORE IMAGE STARTUP ERRORX, 0 TAD I ERRORX /CALL+1 CONTAINS MESSAGE NUMBER TAD (MSGTAB-1 DCA ERRORX TAD I ERRORX DCA ERRORX /POINT AT 6BIT TEXT ERRLUP, TAD I ERRORX /GET A WORD CLL RTR RTR RTR JMS P6CH /PRINT A CHAR TAD I ERRORX /GET WORD AGAIN JMS P6CH /PRINT ANOTHER ISZ ERRORX JMP ERRLUP P6CH, 0 AND (77 /GET 6 BITS SNA