File: BS.TK of Tape: Sources/Multi8/multi8-1
(Source file text)
/BS.TK 5-MAY-81 / /THIS IS THE MAIN POLICY MAKER OF THE TIMESHARING SUBSYSTEM. /THE GENERAL FUNCTION OF THIS TASK IS THE SERVICING OF PAGE- (FIELD-) /FAULTS, (IE. WHEN A BACKGROUND PROGRAM HAS EXECUTED A CDF OR CIF /TO A NON-RESIDENT FIELD) AND TO INSURE THAT EACH USER GETS A /RESONABLE SHARE OF THE MACHINE. SO IT ALLOCATES MEMORY AND /PROCESSOR TIME. / /THIS VERSION IS AN EXTENSION OF THE BACKGROUND SCHEDULER OF /MULTI8 V6 (THE NON-PAGING VERSION). THE GENERAL IDEA IS THAT /AFTER ENTERING A COMMAND (OR, AFTER BECOMMING RUNNABLE) EACH /BG GETS A 'SHORT SLICE', APROX. .5 SECOND OF FIRST PRIORITY /TIME. THE PROGRAMS INSTRUCTION AND DATAFIELD ARE LOADED IN /MEMORY AND THE BG POINTER IS PUT IN SJOB. THE MULTI8 DISPATCHER /WILL FIND IT THERE AND START ITS EXECUTION. IF THE BG DOES NOT /COMPLETE (BECOME INACTIVE) DURING THE SHORT SLICE, IT IS /MARKED 'LONG'. IF THERE ARE NO OTHER 'SHORT' BG AT THIS POINT, /THE BG NOW GETS A 'LONG SLICE' OF APROX. 5 SECONDS. DURING THIS /'LONG SLICE' IT MAY BE INTERRUPTED BY OTHER BG'S THAT BECOME /ACTIVE FOR A SHORT SLICE. A POINTER TO THE EXECUTING LONG BG /IS STORED IN 'LJOB'. THE DISPATCHER FIRST LOOKS AT SJOB FOR /A RUNNABLE BG, THEN LOOKS AT LJOB. /IF A PAGEFAULT OCCURS (BS FINDS AN 'INCORE' REQUEST), IT /WILL TRY TO LOAD THE REQUESTED FIELD. THEREFORE IT HAS TO /FREE A MEMORY FIELD BY WRITING ITS CONTENTS BACK IN THE /SWAPFILE. THE PAGE REPLACEMENT ALGORITHM HAS A LARGE INFLUENCE /ON THE SYSTEMS PERFORMANCE. THE CURRENT ALGORITHM IS EXPLAINED /BELOW: /ALL MEMORY FIELDS ARE IN TURN CONSIDERED IN THE LIGHT OF /A SELECTION CRITERIUM. IF NON CAN BE SELECTED BY THAT CRITERIUM, /A NEW (STRONGER) CRITERIUM IS TAKEN AND ALL FIELDS ARE CONSIDERED /AGAIN. AS ONE FIELD PASSES ONE OF THE TESTS, IT IS SELECTED AND /THE ALGORITHM STOPS. IF NO FIELD CAN BE SELECTED, THE BS SETS /'BSFLAG' AND WAITS FOR A SIGNAL FROM THE CENTRAL EMULATOR. /THE SUCCESSIVE SELECTION CRITERIA ARE: /1 FIELD IS NOT IN USE (OWNER=0) (WILL OCCUR ONLY DURING / STARTUP) /2 FIELD IS OWNED BY AN INACTIVE BG, AND IT IS NOT ITS / INSTRUCTION OR DATA FIELD /3 FIELD IS OWNED BY AN INACTIVE BG. /4 OWNER IS NOT IN EMULATION, AND ITS NOT HIS INSTRCTION / OR DATA FIELD. /5 OWNER IS NOT IN EMULATION /6 OWNER (WHICH IS IN EMULATION) IS NOT THE REQUESTOR, / AND THIS IS NOT HIS LOCKED FIELD. /7 THIS IS A LOCKED FIELD, AND NOT MY INSTRUCTION OR / DATA FIELD. / /EACH BG HAS ONE FIELD (MOST OF THE TIME IT'S INSTRUCTION FIELD) /THAT IS 'LOCKED'. THAT MEANS THAT THIS FIELD MAY NOT BE REMOVED /FROM MEMORY IF THAT BG IS IN EMULATION. THIS INSURES THAT DURING /EMULATION ONE FIELD REMAINS IN MEMORY. EMULATORS MAY CHANGE /THE LOCK FIELD BY REQUESTING ANOTHER FIELD IN MEMORY. AFTER /AN INCORE REQUEST, THE NEW FIELD IS THE LOCK FIELD OF THAT BG. /FIELDS WITH OWNER=-1 ARE NEVER USED. THIS MAKES IT POSSIBLE TO /EXCLUDED CERTAIN FIELDS (EG. IN CASE OF HARDWARE TROUBLES) OR /TO LOCK A FIELD FOR SOME TIME SO THAT IT CAN BE USED BY A /FORGROUND TASK EG. FOR BUFFERING PURPOSE. IN THAT CASE THE /(EMULATOR TASK SHOULD PROCEED AS FOLLOWS: /FIRST REQUEST A FIELD IN MEMORY (EG. USERS FIELD 7) BY /AN 'INCORE' REQUEST. THEN STORE A -1 IN THE OWNER FIELD OF /THAT (REAL) FIELD NUMBER IN BSTAB. WHEN THE TASK IS FINISHED, /IT SHOULD RETORE THE CONTENTS OF THE OWNER FIELD IN BSTAB. /NOTE THAT THE BG CAN EXECUTE NORMALLY DURING THE TIME THIS /THIS FIELD IS LOCKED IN MEMORY. /THE FOLLOWING PARAMETERS CAN BE ALTERED TO TUNE THE SYSTEM /FOR SPECIFIC APPLICATIONS: SLICE1=DGNTICK^2%12 /DURATION OF SHORT SLICE: .4 SECONDS /(NOTE THAT EACH PAGEFAULT HAS A PANELTY /OF .1 SECOND) SLICE2=DGNTICK^1 /DURATION OF LONG SLICE: 5 SECONDS / NOSWER=1 /DO NOT ACCEPT SWAP ERRORS LGMASK=INACTIVE BGSTOP BGERR SWPERR SHMASK=LGMASK LONG SLICE, "B^100+"S&3777 /NAME IS "BS" (BACKGROUND SCHEDULER) 1000+100 /FOUR PAGES, NO CONNECTS; AUTO-START XBSSWAP,BSSWAP XBSTAL, BSTAL XBSCOUN,BSCOUNT XKICK, KICK BSTEMP, 0 BS, CDF 10 /DF=10 MOST OF THE TIME /HERE WE WILL SELECT A NEW BG TO RECIEVE THE BLESSING OF THE CPU. IFNDEF SINGL8 < /OUR FIRST TRY IS FOR BG'S WITH A CLEAR CONCIOUS (AND LONG-BIT). /IF NONE IS AVAILABLE, WE LOOK WHETHER THE LAST ACTIVE LONG BG HAS /ANY CREDIT LEFT. IF THAT IS NOT THE CASE THEN WE MAKE A FULL /SCAN FOR A LONG BG. NOTHING ? THEN WE SIT AND WAIT FOR AN EVENT: /THERE IS NOTHING WE CAN DO. BSNEXT, CLA CDF 0 // TAD I (SJOB //START SCANNING AT CURRENT JOB+1 CDF 10 / JMS BSCAN /LOOK FOR INTERACTIVE JOBS (LONG=0) SHMASK CDF 0 // TAD I (LJOB // CDF 10 / JMS DEFER /GET STATUS AND BLGMSK /RUNNABLE ? SZA CLA JMP BSNXT1 /NO, SELECT OTHER LONG BG TAD X TAD (UCOUNT DCA TSTZ TAD I TSTZ /GET HIS COUNTER SPA CLA /ANY CREDIT LEFT ? JMP BSFOUND /YES; H'S THE BOY BSNXT1, CDF 0 // TAD I (LJOB //START SCANNING AT LAST LONG BG+1 CDF 10 / JMS BSCAN /LOOK FOR ANY LONG BG BLGMSK, LGMASK JMP HANG /END IFNDEF SINGL8 > IFDEF SINGL8 < BSNEXT, CLA /FOR SINGL8 WE MAINTAIN TAD (BGDATA /STRICT PRIORITY OF THE ATTACHED TAD (UKB /BACKGROUND OVER THE DETACHED BG. JMS DEFER / SNA CLA /IS THIS THE ATTACHED ONE ? TAD (UEND /NO, MUST BE THE SECOND ONE TAD X / TAD (-UKB /FETCH THE STATUS OF THE ATTACHED BG JMS DEFER /GET HIS STATUS AND (LGMASK /IS HE RUNNABLE SNA CLA /RUNNABLE ? JMP BSFOUND /IF YES, HE'L BE SELECTED TAD X /IF NOT, CHECK THE DETACHED BG TAD (UNEXT / JMS DEFER / JMS DEFER / AND (LGMASK / SNA CLA /RUNNABLE ? JMP BSFOUND /YES JMP HANG /NO, NOTHING TO BE RUN NOW BLGMSK, LGMASK / > TSTZ, 0 /ULTIMATE TEST ROUTINE, NEVER RETURN ACM1 DCA I (BSFLAG HANG, JMS MONITOR /NOTHING TO DO, WAIT FOR NEW EVENTS WAIT RELEASE BSSLOT JMP BSNEXT /GO AND SEE WHAT HAPPENED IFNDEF SINGL8 < BSCAN, 0 DCA X /REMEMBER THIS TAD (-BGMAX /SET UP COUNTER # OF BG'S DCA ZTEM7 /COUNTER BSCAN1, TAD X TAD (UNEXT JMS DEFER JMS DEFER /GET STATUS OF NEXT BG CDTOIF // AND I BSCAN // CDF 10 SNA CLA JMP BSFOUND ISZ ZTEM7 /IS ROBIN ROUND ? JMP BSCAN1 /NO ISZ BSCAN JMP I BSCAN /YES RETURN > BSFOUND,TAD I X AND (LONG SNA CLA /WAS HE LONG ALREADY ? TAD (-SLICE1 /NO, HE EARNS A SHORT SLICE DCA SLICE / TAD X /FOUND A RUNABLE BG CDF 0 // DCA I (SJOB //THIS IS THE NEW SJOB CDF 10 / JMS I XKICK /LOOK FOR INCORE REQUESTS NOP CDF 0 // TAD I (SJOB //RESTORE X CDF 10 / DCA X TAD X TAD C4 /(UFLDS DCA BSTEMP TAD I BSTEMP JMS I XBSSWAP /SWAP HIS INSTRUCTION FIELD IN DCA X TAD I BSTEMP CLL RAL RTL JMS I XBSSWAP /SWAP HIS DATAFIELD IN TAD (UCOUNT CDTOIF // DCA I XBSCOUN //POINTER TO COUNTER OF CURRENT BG ? CDF 10 /HERE WE COME AFTER LOADING A BG. WE WILL GIVE HIM A MINIMUM /TIME IN WHICH HE WILL NOT BE INTERRUPTED BY OTHER BG'S UNLESS /HE MAKES HIMSELF INACTIVE. BSWAT1, TAD SLICE /GET HIS SWAP-IN CREDIT SNA JMP BSWAT2 /NO CREDIT, NO SHORT SLICE SHORT, JMS I XBSTAL JMP ENDSLC /TIMESLICE EXPIRED ! TAD I X /GET HIS STATUS AND BLGMSK SNA CLA /STILL ABLE TO PROCEED ? JMP SHORT /YES, CONTINUE SHORT SLICE JMP BSNEXT /NO, HE'S GONE INACTIVE. SELECT A NEW ONE ENDSLC, CDF 0 // TAD I (SJOB // DCA I (LJOB //THIS IS THE NEW LONG BG TAD I (LJOB // CDF 10 / JMS DEFER /GET HIS STATUS AND (-LONG-1 TAD (LONG /SET HIS LONG BIT DCA I X TAD X TAD (UCOUNT DCA ZTEM1 TAD (-SLICE2 /GIVE HIM A FULL LONG SLICE CREDIT DCA I ZTEM1 JMP BSNEXT /AND SELECT A NEW BG BSWAT2, CDF 0 // TAD I (SJOB // DCA I (LJOB // CDF 10 / JMS I XBSTAL /DO A LONG SLICE OR WHATEVER IS LEFT JMP BSNEXT /END OF LONG SLICE JMP BSNEXT /OTHER EVENT; GO AND SEE WHAT HAPPENED PAGE /PAGE HEADING: YTSTFLD,TSTFLD YNXTFLD,NXTFLD YBSDO, BSDO YTST, TST1 TST2 TST3 TST4 TST5 TST6 TSTZ YBSCTAB,BSCTAB BSSWAP, 0 AND C70 DCA BSVFLD TAD X DCA BSBASE TAD X DCA BASE TAD BSVFLD JMS I YTSTFLD /IS THIS FIELD PRESENT ? JMP BSSW1 /NO, GO LOAD IT TAD I X /YES, THIS IS THE REAL FIELD JMP BSPRES /FIELD IS PRESENT, QUICK RETURN. /HERE FOLLOWS THE CRITICAL ALGORITHM RESPOSIBLE FOR THE /SELECTION OF A REAL MEMORY FIELD TO BE SWAPPED. BSSW1, TAD (JMS I YTST DCA JMSTST /INDEXED INSTRUCTION BSSW2, TAD (-BGFLDS /SETUP COUNTER TO SCAN ALL BACKGROUND CORE DCA ZTEM1 / TRYNXT, JMS I YNXTFLD /GET NEXT REAL FIELD NUMBER DCA BSRFLD /SEE IF THIS FIELD CAN BE USED TAD BSRFLD CLL RTR RAR TAD (-BGFLD%10!7000+BSTAB+1 DCA BSPNT /INDEX IN MASTER TABLE TAD I BSPNT /FETCH FROM TABLE SNA JMP BSNOSW /FIELD IS FREE, NO SWAP OUT CMA SNA /FIELD LOCKED ? JMP BADFLD /YES CMA AND (0777 /EXTRACT BGOFFSET TAD (BGDATA-1 /ADD BASE OF BG TABLES DCA BSOLDB /PRESENT OWNER TAD I BSOLDB JMSTST, HLT /BECOMES JMS I YTST, YTST+1, ETC. JMP BSGOSW /YES, GO SWAPPING BADFLD, ISZ ZTEM1 /NO, HAVE WE TRIED ALL FIELDS ? JMP TRYNXT /NO, TRY NEXT FIELD ISZ JMSTST /NEXT CRITERION JMP BSSW2 /TRY AGAIN BSGOSW, TAD I BSPNT /ACCESS VIRTUAL FIELD # CLL RTL /EXTRACT VIRTUAL FIELD # RTL / AND C7 / TAD BSOLDB /INDEX IN UFLD-TABLE OF PREVIOUS OWNER TAD (UFLD0 DCA BSSWTM DCA I BSSWTM /ZERO TABLE ENTRY TO SHOW IT'S OUT TAD BSOLDB JMS I YBSCTAB /UPDATE STATUS OF SWAPPED BG TAD I (FRESLT /GET POINTER TO FREE ENTRY IN SWPTAB DCA BSSWTM / TAD I BSPNT /GET VFLD & OFFSET OF LEAVING FIELD DCA I BSSWTM / AC4000 TAD BSRFLD /FUNCTION FOR DTV IN AC JMS I YBSDO /CALL BSDO WHICH COMPUTES BLOCK NUMBER SZA CLA /SWAP ERROR ? IFNDEF NOSWER < ISZ I BSOLDB /YES, SET HIS SWPERR BIT > IFDEF NOSWER < JMP .-4 /TRY AND TRY > BSNOSW, TAD BSVFLD /GET VIRTUAL FIELD # BSW /INTO BITS 0-2 TAD BSBASE TAD (-BGDATA+1 /OFFSET TO USER TABLES IN BITS 3-11 DCA I BSPNT /= NEW OWNER ID & VFLD TAD (SWPTAB-1 / DCA BSSWTM /SET POINTER BSLOOP, ISZ BSSWTM TAD I BSSWTM CIA TAD I BSPNT SZA CLA /WAS THIS THE SOUGHT FOR FIELD? JMP BSLOOP /NO TAD BSSWTM DCA I (FRESLT /POINTER TO SLOT THAT WILL BE FREE IN A MOMENT TAD BSRFLD /SETUP DTV FOR 4K READ JMS I YBSDO /AND CALL BSDO WHICH COMPUTES DISK BLOCK NUMBER SZA CLA /SWAP ERROR ? IFNDEF NOSWER < ISZ I BSBASE /SWPERR=1 ! > IFDEF NOSWER < JMP .-3 /TRY ETERNALLY > DCA I BSSWTM /NOW FREE SLOT IN SWPTAB (DOUBLE ENTRIES?) TAD BSVFLD / CLL RTR / RAR /GET VIRTUAL FIELD NUMBER IN 9-11 TAD (UFLD0 TAD BSBASE DCA X TAD BSRFLD DCA I X /PUT REAL FIELD NUMBER IN USERS TABLE SKP BSPRES, DCA BSRFLD TAD BSBASE JMS I YBSCTAB /UPDATE STATUS OF NEW BG TAD BSBASE JMP I BSSWAP BSSWTM, 0 BSVFLD, 0 /VIRTUAL FIELD (NEW) BSRFLD, 0 /REAL FIELD BSBASE, 0 BSOLDB, 0 BSPNT, 0 PAGE /PAGE HEADER: ZBSRFLD,BSRFLD ZBSSWAP,BSSWAP ZBSDTV, BSDTV ZBSBASE,BSBASE ZTSTFLD,TSTFLD /0 BSTAL, 0 SNA /SETUP OR RESUME WAITING TAD I BSCOUNT SMA /CREDIT OR BONUS ? TAD (-SLICE2 /WAS BONUS, COMPUTE NEW CREDIT SMA /BONUS LARGER THAN CREDIT ? ACM1 /YES, FIX CREDIT AT .1 SECOND DCA I BSCOUNT BSTA1, ACM1 JMS MONITOR WAIT BSSLOT TAD M2 SZA CLA /TIMEOUT? OR SIGNAL FROM EMULATORS? JMP BSSIGN /SIGNAL TAD I (BJOB /GET REALY EXECUTING BG BSTA2, CDF 0 //SJOB IS IN FIELD 0 SNA //IF NO-ONE EXECUTING, CHARGE TAD I (SJOB //THE SHORT JOB CDF 10 /RESET DF TAD (UCOUNT / DCA BSCOUNT /HE IS TO PAY ISZ I BSCOUNT /JUST A CLOCK TICK. THE LAST ONE ? JMP BSTA1 /NO, SLICE NOT YET DONE JMP I BSTAL /YES, SLICE EXPIRED, 1ST RETURN BSSIGN, JMS KICK /LOOK FOR INCORE-REQUEST SJOB JMP BSTA2 /OK, CONTINUE HIS SLICE ISZ BSTAL /NO, NO FIELD REQUEST BY SJOB JMP I BSTAL /FIND OUT WHAT'S GOING ON (2ND RETURN) KICK, 0 /ROUTINE TO HANDLE INCORE REQUESTS CDF 0 // TAD I (SJOB //ONLY LOOK FOR INTERACTIVE JOB !! CDF 10 / JMS DEFER /GET STATUS WORD AND (INCORE+INCFLD /REQUEST BIT +VIRTUAL FIELD NNUMBER SNA /ANNY REQUEST PENDING ? JMP KICK1 /NO, TAKE SKIP RETURN JMS I ZBSSWAP /YES, GET THAT FIELD IN CORE JMS DEFER /RETURN WITH BASE IN AC AND (INCFLD /GET VIRTUAL FIELD REQUESTED MQL AC0002 /(USC TAD X DCA ZTEM7 /POINTER TO USC TAD I ZTEM7 AND C7700 /CLEAR PREVIOUS LOCK FIELD MQA /SET NEW LOCK FIELD DCA I ZTEM7 / TAD I X /GET STATUS AND (-EMULATE-INCORE-INCFLD-1 /CLEAR REQUEST BITS TAD (EMULATE /SET EMULATE TO LOCK THIS FIELD IN CORE DCA I X TAD X TAD (USLOT JMS DEFER DCA BSUSLOT /KICK THE SLOT WHERE HE IS WAITING CDTOIF // TAD I ZBSRFLD //RETURN REAL FIELD # AS STATUS CDF 10 / JMS MONITOR SIGNAL BSUSLOT, 0 SKP CLA KICK1, ISZ KICK JMP I KICK BSCTAB, 0 /COMPUTE 'ONDISK'-BIT DCA BASE AC0004 /(UFLDS TAD BASE DCA ZTEM3 TAD I ZTEM3 CLL RTL RAL /GET DATA FIELD BITS IN 6-8 JMS I ZTSTFLD /IS THIS FIELD PRESENT ? JMP BSCTA1 /NO GO ! TAD I ZTEM3 /ZTEM3 POINTS TO UFLDS JMS I ZTSTFLD /IS INSTRUCTION FIELD PRESENT ? BSCTA1, STL TAD I BASE AND (-ONDISK-1 SZL TAD (ONDISK DCA I BASE DCA I (BJOB /MAKE SURE MMU IS RELOADED JMP I BSCTAB BSDO, 0 /CALL SYSTEM DRIVER FOR 4K TRANSFER DCA BSDTV /CALLED WITH FUNCTION IN AC TAD I (FRESLT TAD (-SWPTAB /CONVERT INDEX TO BLK # CLL RTL RTL / 20 BLOCKS FOR 4K TAD I (BSTAB /ADD BEGIN OF SWPFIL.M8 DCA BSDTV+2 /STORE BLK # IN READ REQUEST CDTOIF // TAD ZBSDTV //POINTER TO BSDTV JMS MONITOR // CALL // "S^100+"Y&3777// JMP .-3 //WE SHURELY WANT HIM DCA .+3 //EVENT # FOR COMPLETION JMS MONITOR // WAIT // 0 // CDF 10 / JMP I BSDO /RETURN WITH COMPLETION STATUS IN AC BSDTV, ZBLOCK 3 /4K TRANSFER VECTOR BSCOUNT,BGDATA+UCOUNT /POINTER TO UCOUNT OF CURRENT BG PAGE /PAGE HEADER: QBSOLD, BSOLDB QBSPNT, BSPNT QBSBASE,BSBASE /0 TSTOWN, 0 /SKIP IF NOT OWN FIELD CDTOIF // CLA // TAD I QBSOLD // CIA // TAD I QBSBASE // CDF 10 / SZA CLA /MY FIELD ? ISZ TSTOWN JMP I TSTOWN TST1, 0 /BLOCKED, NOT I OR D ? AND (LGMASK EMULATE CLL RTL /EMULATE TO LINK SNL SZA CLA JMS TSTID /I OR D ? ISZ TST1 JMP I TST1 TST2, 0 /BLOCKED ? AND (LGMASK EMULATE CLL RTL SZL SNA CLA ISZ TST2 JMP I TST2 TST3, 0 /NOT EMULATE, NOT I OR D ? CLL RTL SNL CLA JMS TSTID SKP JMS TSTOWN ISZ TST3 JMP I TST3 TST4, 0 /NOT EMULATE ? CLL RTL SNL CLA JMS TSTOWN ISZ TST4 JMP I TST4 TST5, 0 /EMULATE, NOT OWN, NOT LOCKED ? JMS TSTOWN /DON'T TOUCH OWN FIELDS SKP JMS TSTLCK /LOCKED ? ISZ TST5 /ONE OF THEM. DON'T TOUCH JMP I TST5 TST6, 0 /SKIP IF LOCKED OR I OR D JMS TSTID SKP JMS TSTLCK ISZ TST6 JMP I TST6 TSTLCK, 0 /SKIP IF NOT LOCKED CDTOIF // CLA CLL // TAD I QBSPNT // DCA ZTEM6 //POINTS TO BSTAB ENTRY TAD I QBSOLD // TAD (USC // DCA ZTEM7 //POINTS TO LOCKED FIELD BITS CDF 10 / TAD I ZTEM6 BSW /GET VFIELD IN 6-8 AND C70 /GUESS WHY!! CIA TAD I ZTEM7 /COMPARE WITH LOCK FIELD AND C70 /LOCKED FIELD SZA CLA ISZ TSTLCK JMP I TSTLCK TSTFLD, 0 /ENTER WITH VIRTUAL FIELD NUMBER IN 6-8 AND C70 CLL RTR RAR TAD (UFLD0 TAD BASE /INDEX IN FIELD TABLE OF CURRENT BG JMS DEFER SZA CLA /FIELD PRESENT ? ISZ TSTFLD /YES, SKIP JMP I TSTFLD TSTID, 0 /SKIP IF FIELD IS NOT I OR D CDTOIF // CLA CLL // TAD I QBSPNT // DCA ZTEM6 //POINTS TO OF BSTAB ENTRY TAD I QBSOLD // TAD (UFLDS // DCA ZTEM7 //POINTS TO UFLDS OF OWNER CDF 10 / TAD I ZTEM6 BSW /GET VFIELD IN 6-8 AND C70 /FORCE CARRY TO 8 CIA TAD I ZTEM7 /COMPARE VFIELD WITH INSTRUCTION FLD AND C70 /GET VIRTUAL INSTRUCTION FIELD SNA CLA /EQUAL ? JMP I TSTID /YES, QUIT TAD I ZTEM6 / CLL RTL / RTL /GET VFIELD IN 9-11 CIA / TAD I ZTEM7 /COMPARE WITH DATA FIELD AND C7 /DATAFIELD SZA CLA /EQUAL ? ISZ TSTID /NO: SKIP JMP I TSTID NXTFLD, 0 /ROUTINE TO COMPUTE NEXT REAL CORE FIELD # TAD CURFLD /GET THE CURRENT FIELD CMA TAD (BGFLDS CIA SZA TAD (BGFLDS /WRAP AROUND DCA CURFLD TAD CURFLD CLL RTL RAL /RESULT IN 6-8 TAD (BGFLD /ADD OFFSET JMP I NXTFLD /RETURN CURFLD, 0 $