File: M3.PA of Disk: Disks/MyPDP/m8-blue-rka1-rkb1
(Source file text)
/M3.PA 17-JUN-80 /**UASEM VERSION** XLIST -LEMULA-1&XLISTX IFNZRO BGMAX < /************************************************************ /******* B A C K G R O U N D E M U L A T O R ********** /************************************************************ INACTIV=4000 /BIT TOGGLED BY IO DEVICES AND EMULATOR. /IF SET, BG CAN'T PROCEED EMULATE=2000 /BG IS BUSY IN EMULATION. THIS BIT MEANS /THAT THE BG SHOULD NOT BE STARTED /NOR SWAPPED OUT BGSTOP=1000 /REQUEST TO STOP THE BG. THE DISPATCHER LOOKS /AT IT AND THE BG SCHEDULER. ALSO SOME TASKS /THAT WORK FOR AN EXTENDED PERIOD. IS SET /BY THE INPUT READER WHEN IN ^B-MODE ONDISK=400 /IF SET THE BG IS NOT IN CORE LONG=200 /SET IF BG NEEDS MORE THAN A SHORT SLICE INCORE=100 /REQUEST FROM EMUL. TO "BS" TO MOVE BG IN CORE INCFLD=70 /SET TO REQUEST A FIELD IN CORE /BIT 9 IS RESERVED BGERR=2 /SET BY EMULATOR IN CASE OF ILLEGAL /INSTRUCTION. BRINGS INPUTREADER IN ^B-MODE. SWPERR=1 /SET WHEN A DISK ERROR OCCURS DURING /A SWAP OPERATION /ZTEM USAGE: /DEFER,GET,PUT: X /LOCAL TEMPS: ZTEM1,ZTEM2,ZTEM3 /TSTJMP: ZTEM4 /EMFETCH: ZTEM5 /DISPATCH: ZTEM6,ZTEM7 DISP6, MQL /HERE FROM DISP3,4,5 IN FIELD 0 MQA CIA TAD BJOB SNA CLA JMP DISP7 /REGISTERS STILL OK MQA /HERE THE DISPATCHER HAS DECIDED TO RUN A TAD (UFLD0-1 /BG DIFFERENT FROM THE PREVIOUS ONE. SO THE DCA AUTO10 /MEMORY MANAGEMENT UNIT HAS TO BE LOADED TAD (-BGCORE /WITH THE PROPER FIELD INFORMATION. DCA ZTEM7 CLA CLL IAC BSW /AC0100 WITH CLL DCA ZTEM6 DCA BJOB /NOW W'LL DISTURB THE MMU TRAP0, TAD I AUTO10 /GET REAL FIELD # IN BIT 6-8 SNA /IS THIS FIELD PRESENT ? JMP DNTREL /NO, DON'T CHANGE REL.REG. TAD ZTEM7 /GET VIRTUAL FIELD # IN BIT 9-11 TAD (BGCORE /COMPLEMENT LINK TO 1 6245 /LOAD RELOCATION REGISTER, CLA DNTREL, TAD ZTEM6 /2N1 UNTRAP OR 2N0 TRAP RAL /FUNCTION OF LINK 6235 /LOAD UNTRAP REGISTER, CLA AC0004 /NEXT FIELD AND CLEAR LINK TAD ZTEM6 DCA ZTEM6 ISZ ZTEM7 /ALL FIELDS DONE ? JMP TRAP0 /NO, CYCLE MQA DCA BJOB /SET BJOB NOW DISP7, TAD BJOB / DCA AUTO14 / IFDEF EAE < TAD I AUTO14 /FETCH MQ SWAB /LOAD MQ;SET MODE B AC4000 / TAD I AUTO14 /FETCH STEPCOUNTER, FLIPS MODE TO LINK BSW /GET STEPCOUNTER VALUE IN 7-11 ASC /LOAD STEPCOUNTER FROM AC SNL CLA /OVERFLOW FROM MODE-BIT? SWBA /SET MODE A > IFNDEF EAE < TAD I AUTO14 /FETCH MQ FROM CORE MQL /LOAD MQ ISZ AUTO14 /SKIP STEPCOUNTER > TAD I AUTO14 /FETCH PC DCA ZTEM1 /SET UP FOR RETURN TAD I AUTO14 /FETCH FIELDS +LINK ETC. DCA ZTEM2 /PREPARE FOR INTERRUPT EXIT TAD I AUTO14 /FETCH AC DCA ZTEM3 / CIF CDF 0 ///INHIBIT INTERRUPTS, DATAFIELD=0 ISZ I (CURTSK ///SHOW THAT BG IS RUNNING TAD ZTEM2 /// RTF ///THIS UNDOES THE PREVIOUS CIF 0 CLA ///(!"#%$#$#"!) TAD ZTEM3 /// JMP I ZTEM1 ///THERE WE GO ! /*********************************************************** /*********** C E N T R A L E M U L A T O R *********** /*********************************************************** TRAPINT,CINT ///CLEAR THE TRAP INTERRUPT FLAG TAD BJOB /// TAD (UCUR ///FETCH TCBP OF EMULATOR TASK DCA X /// TAD I X /// CDF 0 /// ION /// DCA I (CURTSK ///MAKE EMULATOR TASK RUNNING CDF 10 / TAD BJOB /BJOB SAYS WHICH BG DCA BASE / AC2000 /TAD (EMULATE IFNZRO EMULATE-2000 <EMULER,XERROR> TAD I BASE DCA I BASE /SET EMULATE. 6205 /GET THE ROTTEN INSTRUCTION JMS PUT / UINST /STORE INSTRUCTION IN DATAAREA AC2000 /TAD (-IOT TAD I X /IS IT AN IOT? AND C7000 SZA JMP I (EMHLT /NO, MAYBE AN OSR OR HLT TAD (EMTAB /WHICH IOT? USE THE DISPATCH LIST DCA ZTEM1 /STORE FOR FLEXIBILITY 6205 /6XY. EMH, CLL RTR RAR /.6XY EM1, AND C77 /00XY TAD ZTEM1 /GET PREV. DEFINED BASE EM2, DCA ZTEM1 /POINTER IN TABLE EM3, TAD I ZTEM1 SMA JMP I (EMCALL /POSITIVE = NAME OF EMULATOR TASK CIA /EMULATE THE IOT DIRECTLY EMDOT, TAD (. /NEGATIVE: -ADDRESS+EMDOT DCA ZTEM1 /EMDOT+DIFFERENCE=ADDRESS JMP I ZTEM1 /JUMP TO RESIDENT EMULATOR ROUTINE EM00, TAD (EM00TB /PROCESSOR IOT'S EMULATOR JMP EMLIST /SET BASE OF PROC. GROUP /CONSOLE EMULATOR , EMULATES ALL 603X AND 604X IOT'S EM03, TAD (EM03TB-30 /COMPENSATE FOR XX3X JMP EMLIST / EM20, TAD (EM20TB /CDF-CIF GROUP EMULATOR EMLIST, DCA ZTEM1 /SET BASE OF CDF GROUP 6205 /DECODE THE CDF GROUP JMP EM1 /REJOIN DOT PROCESSOR EMGIGA, JMS GET /GIANT IOT EMULATOR UAC /UAC CONTAINS FUNCTION CODE CLL / TAD (-GIGAMX SZL /LESS THAN MAX. ? JMP I (EMERROR /NO, OUT OF RANGE TAD (GIGAMX+GIGATB /FUNCTIONS ARE DEFINED IN GIGATB, JMP EM2 /WHICH HAS THE SAME ENCODING AS EMTAB EMHD, TAD (HNDTAB /EMULATOR DISPATCH FOR CHANNELS DCA ZTEM1 /BASE OF HANDLER TABLE JMS GET UAC /AC=XY, X=EMULATOR, Y=UNIT AND C77 /MASK OUT RUBBISH JMP EMH /ROTATE X TO Y AND GO PAGE EMNUMB, JMS GET /GET BG AND TERMINAL NUMBER IN AC UNUMB /FORM : /000/BBB/000/TTT/ AND C7 /GET BG FROM DEVICE TYPE: 45BB BSW MQL /SAVE IN HIGH 6-BIT JMS GET /GET TERMINAL NUMBER UKB SNA /DETACHED BG ? JMP NOTERM /YES, RETURN BG NUMBER ONLY TAD (-TCBTAB-4 CLL RTR RAR /OFFSET IN NAMLST TAD (NAMLST CDF 0 //FETCH NAME OF KEYBOARD DRIVER JMS DEFER // CDF 10 / AND C7 /GET TERMINAL NUMBER IN AC NOTERM, MQA /MERGE BG AND TERM JMP I (EMCLA /AND STORE IN USERS AC EMCDIF, JMS EMCHCK /ANY CIF-DELAYED TRAP ? JMP EMERROR /YES, HE SPOILED IT 6205 /GET INSTRUCTION AGAIN JMS EMGETF /LOAD FIELD INTO CORE EMBRED, CLA /CLEAR FIELD INFO JMS GET UPC TAD M1 DCA I X /RESET USERS PC, SO HE WILL TRY AGAIN JMP I (EMREDY EMCHCK, 0 /COMPARE BG TRAP-INSTRUCTION WITH (PC-1) JMS GET /6205 NOT ALLOWED, MAY BE SET BY USER UINST /GET INSTRUCTION DCA ZTEM1 /SAVE A WHILE ACM1 /PC-1 JMS I (EMFETCH /USES CDTOAC, ZTEM5 POINTING TO BG INST CIA /-WORD FOR COMPARE WITH TAD ZTEM1 /THE TRAPPED INSTRUCTION SNA CLA /SHOULD BE EQUAL ISZ EMCHCK /OK, NORMAL RETURN JMP I EMCHCK /RETURNS WITH NORMAL DF=10 !! EMGETF, 0 /THIS ROUTINE INSURES THAT THE VIRTUAL AND C70 /FIELD INDICATED IN AC 6-8 IS LOADED AND LOCKED DCA EMGVIR /IT RETURNS ITS REAL FIELD IN AC 6-8. TAD EMGVIR /FIRST WE TEST IF THE FIELD IS ALREADY CLL RAR /BY LOOKING IN THE USER FIELDS TABLE RTR / JMS GET /IF THE ENTRY IS ZERO, IT'S NOT THERE UFLD0 /OTHERWISE THE ENTRY IS THE REAL FIELD # SZA /ARE WE LUCKY ? JMP EMQUICK /YES, BUT DON'T FORGET TO LOCK IT ! TAD EMGVIR /NO, GET BACK REQUESTED VIRTUAL FIELD TAD (-EMULATE+INCORE /TO SETUP AN INCORE REQUEST FOR BS TAD I BASE /BY CLEARING EMULATE AND SETTING INCORE DCA I BASE / TAD EMGETF /NOW WE WILL CALL THE MONITOR, SO WE JMS PUT /HAVE TO SAVE THE RETURN ADDRESS FIRST UTEMP / JMS I (EMBSINT /SEND A SIGNAL TO BS TO WAKE HIM UP JMS GET /NOW WE WAIT AT THIS USERS EVENT. USLOT / DCA .+3 / JMS MONITOR /AFTER SWAPPING THE FIELD IN MEMORY, BS WAIT /WILL SEND US AN EVENT WITH THE REAL EMGVIR, 0 /FIELD # IN THE AC 6-8 RERTRN, DCA MONITOR /THERE IT IS ! (ALSO GENERAL RETURN) JMS SETBASE /FIRST RESTORE BASE JMS GET /RESTORE THE RETURN ADDRESS TOO UTEMP / DCA EMGETF / EMQEND, TAD MONITOR /NOW PICKUP THE REAL FIELD NUMBER JMP I EMGETF /AND RETURN /. . . . . . . . . . . /THIS ROUTINE SHOULD BE MQ FREE EMQUICK,DCA MONITOR /SAVE THE RESIDENT REAL FIELD # JMS GET USC /GET THE WORD CONTAINING 'LOCK FIELD' AND C7700 /KEEP SC AND USER MODE TAD EMGVIR /ADD IN THE !VIRTUAL! FIELD TO LOCK DCA I X /STORE BACK IN USC JMP EMQEND /FINALLY GIVE REAL FIELD BACK EMCLCA, JMS GET / UFLDS AND (3777 /CLEAR AC AND LINK DCA I X /BACK TO UFLDS JMP I (EMCLA /AND CLEAR AC THERE EMERROR,JMS SETBASE TAD C2 /(BGERR TAD I BASE DCA I BASE /SET ERROR BIT IN STATUS TAD (EMREDY /AND KICK BS JMP I (EMBSI1 EMXSKP, TAD (SKP-NOP EMXNOP, TAD C7000 /(NOP EMX, MQL /HERE FROM EMCALL WITH PATCH IN AC JMS EMCHCK /CIF-DELAYED TRAP ? JMP I (EMREDY /YES, DON'T PATCH THE WRONG PLACE (NOP) TAD XACCDF /USE CDF USED IN 'CDTOAC' IN 'EMFETCH' CDTOAC /CALLED FROM EMCHCK, REDO IT CLA MQA // DCA I ZTEM5 //PATCH THE INSTRUCTION CDF 10 JMP EMBRED /RESTART USERS PROG. AT PC-1 EMHLT, TAD M1000 /=-OPR+IOT SZA CLA /MUST BE OPERATE INSTRUCTION JMP EMERROR /SPURIOUS TRAP (HARDWARE FAILURE ?) 6205 /FETCH THE INSTRUCTION TAD (-OSR AND (7406 /IGNORE THE CLA AND SKIPS. IF PRESENT, THEY /WERE ALREADY DONE BY THE HARDWARE ! SZA CLA /OSR ? JMP EMERROR /NO, ILLEGAL COMBINATION JMS GET /GET THE USERS VIRTUAL SWITCH REGISTER USW JMP I (EMOR /OR INTO UAC EMQUIT, AC4000 /SET ECHO DISABLED EMECHO, JMS PUT /OR ENABLED UECHO JMP I (EMCLA /CLEAR AC PAGE EMCALL, SNA JMP I (EMREDY /NON-EXECUTABLE IOT EM9, DCA EMNAME TAD BASE /TELL THE TASK FOR WHOM IT WORKS CLL /NORMAL CALL IS WITH ZERO LINK JMS MONITOR CALL EMNAME, 0 /NAME, REPLACED BY TCBP JMP EMWAIT /IF TASK BUSY: TRY AND TRY ... MQL /SAVE AC JMS SETBASE /RESTORE BASE CLA MQA /GET AC SPA /DO WE WANT TO PATCH ? JMP I (EMX /GO PATCH BG, INSTRUCTION IN AC SNA /NORMAL RETURN ? JMP I (EMREDY /YES TAD M2 /WAS ERROR SPECIAL BUSY CODE ? SNA CLA JMP EMWAIT+1 /YES, WAIT (SKIP 'DCA BASE') JMP I (EMERROR /NO, REAL ERROR EMWAIT, DCA BASE /WE FORGOT BECAUSE OF THE CALL TAD EMNAME /FETCH TCBP OF BUSY TASK SMA /NAME OR TCBP ? JMP I (EMERROR /NAME! COULDN'T FIND IT ! JMS PUT /AND STORE IN UTEM2 UTEM2 /UTEMP USED BY EMGETF JMS I (EMINACT /DEACTIVATE BG EMW1, JMS MONITOR /AND WAIT ... STALL DGNTICK%12 JMS SETBASE TAD I BASE AND (BGSTOP SZA CLA /SEE IF USER HAS MORE PATIENCE JMP I (EMBRED /NO, DON'T WAIT ANY LONGER JMS GET UTEM2 / TAD M4 /GET PNTR TO BACKLINK OF BUSY TASK CDF 0 // JMS DEFER //GET HIS BACKLINK CIA // SZA //IS HE FREE NOW ? TAD I (CURTSK //COMPARE WITH CURTSK SZA CLA //OR IS HE FREE FOR ME ? JMP EMW1 //NO TAD I (CURTSK //YES, CLAIM HIM ! DCA I X // CDF 10 / TAD (EMULATE-INACTIV TAD I BASE /SET EMULATE FOR DCA I BASE /EMGETF CALL JMS GET / UFLDS /GET USERS FIELDS WORD JMS I (EMGETF /GET INSTRUCTION FIELD IN CORE CLA /CLEAR FIELD INFO JMS GET UTEM2 /GET TCBP OF TASK WE WERE AFTER JMP EM9 /GO BACK TO MAINSTREAM PROCESSING /COPY UTEMP INTO EMNAME AND EMLAST BGREL, JMS EMREL /SPECIFIC RELEASE DEVICES JMP I (EMCLA /CLEAR AC /**UASEM VERSION** EMREL, 0 /ROUTINE TO RELEASE ALL CLAIMED DEVICES TAD EMREL /FIRST SAVE RETURN ADDRESS JMS PUT / UTEM2 / TAD K10 /ANY CONSTANT WITH BITS 6-8=1 JMS I (EMGETF /GET FIELD 10 INCORE TAD C6201 /MAKE CDF TO VIRTUAL FIELD 1 DCA .+2 / TAD I (OS8DATE HLT // DCA I (OS8DATE //STORE SYSTEM DATE IN OS8 K10, CDF 10 JMS PUT /ENABLE ECHO UECHO TAD (UASEM /WE PUT A RELATIVE POINTER TO THE LIST JMS PUT /OF ASSIGNABLE EMULATOR TASKS UTEMP /IN UTEMP EMLOOP, JMS GET UTEMP TAD (-UASEM-ASEMMX SNA CLA /END OF UASEM TABLE ? JMP EMREL1 /YES, RETURN TAD I X /GET RELATIVE POINTER AGAIN TAD BASE /NOW SELECT CORRECT BG ISZ I X /BUMP UTEMP JMS DEFER /FETCH NAME FROM UASEM TABLE SNA JMP EMLOOP /NO ONE HERE, TRY NEXT ENTRY DCA UASNAM /NAME FOR RELEASE CALL DCA I X /AND CLEAR NAME IN UASEM TABLE TAD BASE /SHOW WHO'S CALLING OFF STL /RELEASE CALL IS WITH LINK=1 ! JMS MONITOR /RUN THESE TASKS RUN /THEY WILL MAKE AN 'EXIT' UASNAM, 0 JMP .-3 /IF THEY ARE BUSY, TRY AND TRY JMS SETBASE / JMP EMLOOP EMREL1, JMS GET /GET RETURN ADDRESS UTEM2 DCA EMREL / JMP I EMREL /AND RETURN PAGE O=VERSLO&77 /GIANT IOT 12 EMVER, TAD (VERSHI^100+O /GIVE BACK MULTI8 VERSION JMP EMCLA /SET AC TO 6-BIT PACKED IFDEF EAE < EMSGT, JMS GET / UFLDS /GREATER THAN FLAG IS IN FLAG-WORD RAL /BIT 1: TEST IT SMA CLA / JMP EMREDY / > EMSKIP, JMS GET / UPC /SINT WORKS AS SKIP ON MULTI8 IAC DCA I X /BACK TO PC EMREDY, CLA /NEVER TRUST A USER ! (FEATURE IS USED) TAD (-INACTIVE-EMULATE-1 /CLEAR STATUS AND I BASE DCA I BASE TAD BSFLAG /BG SCHEDULER RINGING? SNA CLA JMP DISP DCA BSFLAG /Y;CLEAR THE REQUEST JMS EMBSINT /TELL BS WE'RE READY DISP, CIF CDF 0 JMP I (DISPATCH /GO ! BSFLAG, 0 /COMMUNICATION FLAG EMULATOR/BG-SCHEDULER TSTJMP, 0 /TEST FOR 'JMP .+X' : +-X IN AC TAD (5000 /MAKE 'JMP Z +-X' DCA ZTEM4 JMS GET UPC /WHERE IS PROGRAM? AND C177 /IN THIS PAGE TAD ZTEM4 CIA /NEG FOR TEST DCA ZTEM4 /NOW 'JMP Z .+-X' JMS I (EMFETCH /GET INSTR. AND (7577 /PAGE Z OR CURRENT TAD ZTEM4 /IDENTICAL? SNA CLA ISZ TSTJMP /YES, SECOND RETURN JMP I TSTJMP /NO, FIRST RETURN EMACTIV,0 /MAKE BG ACTIVE TAD I BASE AND (-INACTIV-EMULATE-LONG-1 /CLEAR INACTIV AND LONG TAD (EMULATE /SET EMULATE DCA I BASE TAD EMACTIV JMP EMBSI1 /GO KICK BG-SCHEDULER EMINACT,0 /ROUTINE TO DEACTIVATE THIS BG AC2000 /TAD (INACTIV-EMULATE TAD I BASE DCA I BASE TAD EMINACT JMP EMBSI1 /GO KICK THE BG-SCHEDULER EMBSINT,0 /INTERRUPT BG-SCHEDULER TAD .-1 /KEEP RETURN ADDR. IN AC FOR REENTRANCY EMBSI1, JMS MONITOR /BG-SCHED. ONLY LOOKS FOR TIMEOUT (=2) SIGNAL BSSLOT EMBSI2, DCA EMBSINT /RESTORE RETURN ADDRESS JMS SETBASE JMP I EMBSINT /RETURN WITH BASE OK EMRUN, 0 /ROUTINE TO RUN AN EMULATOR TASK TAD I EMRUN /ARG=OFFSET OF TCBP IN BGDATA ISZ EMRUN TAD BASE JMS DEFER DCA EMRUN1 /STORE IN RUN-REQUEST TAD EMRUN1 SMA JMP EMRUN0 /NOT TCBP POINTER TAD M4 CDF 0 // JMS DEFER //FETCH HIS BACKLINK CDF 10 / SZA CLA /RUNNING ? JMP I EMRUN /YES EMRUN0, CLA TAD EMRUN /KEEP RETURNADDRESS TIGHT JMS MONITOR RUN EMRUN1, 0 NOP /IF HE WAS RUNNING ALREADY: OK JMP EMBSI2 /SAME CODE ACCRD, JMS GET /READ USERS ACCOUNT REGISTER IN UACCNT /HIS MQ AND AC. MQ GET LEAST SIGNIFICANT JMS PUT /PART. UMQ / JMS GET / UACCNT+1 / JMP EMCLA /AC GETS MOST SIGN. PART. ACCRST, JMS PUT /RESET ACCOUNTING REGISTERS UACCNT / JMS PUT / UACCNT+1 / JMP EMCLA /AND CLEAR USER AC EMSTLL, AC0001 /FETCH PARAMETER FROM USERS CORE AT PC+1 JMS I (EMFETCH / JMS PUT /STORE AWAY UTEMP /IN USERS AREA JMS EMINACT /DEACTIVATE THIS BG STLL0, JMS MONITOR STALL DGNTICK JMS SETBASE /RESTORE BASE TAD I BASE / AND (BGSTOP / SZA CLA /CONTROL/B MODE ? JMP STLL1 /YES, DON'T WAIT ANY LONGER JMS GET / UTEMP /GET DELAY COUNTER TAD M1 /SUBSTRACT ONE SNA /DONE ? JMP STLL1 /YES DCA I X /NO, UPDATE DELAY COUNTER JMP STLL0 /AND STALL ANOTHER SECOND STLL1, JMS EMACTIV /ACTIVATE THIS BG AGAIN EMCLA, JMS PUT /ZERO UAC UAC JMP EMREDY /RETURN PAGE DO6044, DO6046, JMS GET / UAC /GET THE CHAR SNA JMP I (EMREDY /IGNORE NULLS DCA ZTEM1 /KEEP FOR FOLLWING TESTS JMS GET UCHAR / SPA JMP D6046X /THIS CHAR HAS NOT YET BEEN ECHOED. CIA TAD ZTEM1 /COMPARE THIS CHAR AND LAST INPUT CHAR AND C177 /STRIP EXCESS BITS IN UAC SNA CLA /IS THIS THE ECHO ? JMP KHEXT2 /YES, IGNORE IT TAD I X /SEE IF THE INPUT CHARACTER WAS A TAB TAD (-211 SZA CLA /TAB ? JMP D6046A /NO TAD ZTEM1 /YES, MUST IGNORE SPACES ECHOED... TAD (-240 AND C177 /CLEAR EXCESS BITS IN UAC D6046X, SNA CLA /SPACE ? JMP I (EMREDY /YES, DON'T ECHO ! DON'T CLEAR UCHAR ! D6046A, JMS GET /NO, PUT IN OUTPUT BUFFER UAC JMS I (FILLQ UBUFOUT /ONE WORD TO OUTPUT BUFFER SNA CLA /CHAR ACCEPTED ? JMP KHEXT /YES IFNDEF SINGL8 < JMS I (EMINACT /NO, DEACTIVATE BG > O=BSIZE-1^POOLN%20^DGNTICK%36 /THIS IS FOR **2400 BAUD** IFZERO O <O=1> /2400BAUD=240 CHARS/SEC=36^10 OCTAL OO=BSIZE-1^POOLN%2%TTYMAX D6046C, JMS MONITOR / STALL DGNTICK%12 / O JMS SETBASE /RESTORE BASE IFNDEF SINGL8 < JMS GET /GET COUNTER OF OUTPUT BUFFER UBUFOUT TAD (-OO /NEARLY EMPTY ? SMA CLA JMP D6046C / JMS I (EMACTIV /ACTIVATE BG > JMP D6046A /TRY AGAIN KHEXT, JMS I (EMRUN /RUN OUTPUT WRITER UWRTR JMS PUT /CLEAR UCHAR UCHAR / JMP I (EMREDY KHEXT2, TAD I X /IF THE CHAR WAS CR TAD M215 SNA CLA /WE KNOW THAT A LF WAS ECHOED TOO TAD C212 DCA I X /PUT IN UCHAR JMP I (EMREDY /6031 TEST WHETHER THERE IS A NEW CHARACTER AVAILABLE DO6031, IFDEF SINGL8 < IFDEF SYRX02 < TAD (-DGNTICK^7 /SET COUNTER FOR 7 SECONDS > IFNDEF SYRX02 < TAD (-DGNTICK /SET COUNTER FOR 1 SECOND > JMS PUT /IN UTEM2 UTEM2 / > S8WAIT, JMS GET / UBUFIN SZA CLA /EMPTY ? JMP I (EMSKIP /NO, LET BG SKIP ACM1 /TEST IF JMP .-1 IS FOLLOWING JMS I (TSTJMP /IF THE CASE, WE HANG UP USER JMP I (EMREDY /NO, NOT OBVIOUSLY WAITING IFDEF SINGL8 < JMS MONITOR /WAIT 7 SECONDS FOR INPUT, STALL /THEN DEACTIVATE THE BG DGNTICK%12 / JMS SETBASE / JMS GET / UTEM2 /GET COUNTER CLA /ONLY NEED X FOR SKIP ISZ I X /UPDATE COUNTER JMP S8WAIT / > JMS I (EMINACT /MAKE HIM INACTIVE NOW JMS MONITOR /EXIT UNTIL RUNNED BY INPUT READER EXIT EMSTRT, JMS SETBASE JMS I (EMACTIV /ACTIVATE BG JMP I (EMREDY DO6036, JMS I (GETQ /FETCH CHAR FROM BUFFER UBUFIN AND (377 DO6032, JMS PUT / UAC /STORE IN/CLEAR UAC DO6030, JMS I (GETQ UBUFIN JMS ESCALT JMS PUT UCHAR /USED FOR SUPPRESSION OF BG-ECHO JMS I (MTQ /BUMP INPUT BUFFER UBUFIN JMP I (EMREDY /EMPTY JMP I (EMREDY /CLA;JMP EMREDY ESCALT, 0 /ROUTINE TO CONVERT 233 IN $ TAD (-233 / SNA /ESCAPE ? TAD ("$-233 /MAKE IT A $ TAD (233 JMP I ESCALT DO6034, JMS I (GETQ /LOOK INTO BUFFER UBUFIN AND (377 EMOR, MQL JMS GET / UAC MQA /INCLUSIVE OR JMP I (EMCLA /STORE IN AC EMSPY, JMS I (EMFETCH /GET PARAMETER = FIELD AND C70 TAD C6201 DCA .+3 JMS GET UAC HLT //CDF TO FIELD USER WANTS TO SEE DCA ZTEM1 TAD I ZTEM1 CDF 10 DCA I X /BACK TO UAC JMP I (EMSKIP /SKIP PARAMETER PAGE /******************************************************* /*********** I N P U T R E A D E R *************** /******************************************************* /KHI IS A TASK DEDICATED TO READ CHARACTERS FROM AN /INPUT DEVICE AND PUT THEM INTO THE INPUT BUFFER. /IT ALSO TAKES CARE OF THE ECHO, BY PUTTING CHARS /INTO THE OUTPUT BUF AND STARTING THE OUTPUTWRITER . /ALSO IT LOOKS FOR CONTROL-B CHARACTERS IN THE INPUT. /^B WILL SET 'BGSTOP' AND THUS ESTABLISH ^B-MODE IN /WHICH KHI WILL ACCUMULATE ONE INPUT BUFFER OF COMMAND. /WHEN THE LINE IS CLOSED /WITH A CARRIAGE RETURN, KHI WILL CALL "CB" TO EXECUTE /THE COMMAND. IN CASE THE BGERR BIT GETS SET, IT WILL /CALL THE ERROR PRINTER "BE" AND ENTER ^B-MODE. KHI0, JMS MONITOR /DETACHED BG, JUST STALL STALL /AND TRY AGAIN LATER DGNTICK /ONE SECOND IS AN EASY PACE KHI11, JMS SETBASE /NECESSARY IN CASE OF TIMEOUT JMS GET UBUFIN SNA CLA /ANY INPUT WAITING ? JMP KHILP /NO KHIRUN, JMS I (EMRUN /START THE EMULATOR UCUR KHI, JMS I (EMRUN UWRTR KHILP, TAD I BASE AND C3 /(BGERR+SWPERR SZA CLA /ERROR IN EMULATION OR SWP ? JMP I (KHI8 /Y, GET INTO ^B-MODE JMS GET UKB SNA /DETACHED BG ? JMP KHI0 /YES, STALL, THEN TRY AGAIN DCA KHINAM / JMS GET /GET NUMBER OF CHARACTERS IN INPUT UBUFIN /BUFFER. WE WILL USE THAT TO DETERMINE CLL RAR / TAD M4 /THE OPTIMUM TIMEOUT FOR THE NEXT SMA /CHARACTER. THIS TIMEOUT IN FACT CLA /DETERMINES THE ACTIVATION RATE FOR TAD C4 /BACKGROUNDS. CIA /DELAY=#CHARS*.1+.3 SECONDS TAD M3 / JMS MONITOR CALL KHINAM, K1TCBP JMP KHI3 /INPUT HANDLER BUSY: STALL AND TRY SPA SNA /IGNORE NULL'S JMP KHI11 /TIMEOUT, ACTIVATE BG DCA ZTEM1 /SAVE TEMP JMS SETBASE /FOR WHICH BG? MAY HAVE CHANGED! TAD ZTEM1 / TAD (-203 /TEST FOR ^C SZA / IAC /TEST FOR ^B SZA TAD (202-217 /TEST FOR ^O SNA JMP I (KHI4 /CLEAR IN AND OUT BUFFERS, RETEST ^B TAD M4 /TEST FOR ^S SNA JMP KHISTP /STOP OUTPUT WRITER TAD C2 /TEST FOR ^Q SNA CLA JMP I (KHICON /RESTART OUTPUT WRITER KHINRM, JMS I (KHTEST /CONTROL GROUP OR PRINTING GROUP ? NOP /DON'T ECHO CONTROL CHAR AC4000 /NON-ECHO MODE TAD ZTEM1 /ENTER CHAR INTO INPUT BUF JMS I (FILLQ /ONE WORD TO INPUT BUFFER UBUFIN SNA CLA JMP KHECHO /OK JMS I (KHIOUT /GIVE WARNING (BELL) 207 JMP KHI /BUFFER FULL, KEEP LISTENING KHECHO, JMS I (KHTEST /ECHO OR NOT - THAT'S THE QUESTION. JMP KHIRUN /CONTROL CHAR - DON'T ECHO, ACTIVATE BG JMP KHIRUN /NON-ECHO MODE TAD ZTEM1 JMS I (ESCALT /CONVERT 233 TO $ JMS I (KHIOUT TAD ZTEM1 TAD M215 SZA /CR IS VERY DELICATE JMP KHI12 /NOT CR, JUST WAIT FOR MORE TAD C212 /ADD A LF TO THE CR JMS I (KHIOUT TAD I BASE AND (BGSTOP SZA CLA /ARE WE IN ^B MODE ? JMP I (KHI5 /YES, GO THERE JMP KHIRUN /AND ACTIVATE THE BG IFNDEF SINGL8 < KHI12, TAD (215-233 SNA CLA /ESCAPE IS ANOTHER PET CHARACTER JMP KHIRUN /RUSH THE BACKGROUND ACTIVE JMP KHI /NO, DON'T PANIC > IFDEF SINGL8 < KHI12, CLA /ALWAYS START THE JMP KHIRUN /BACKGROUND IMMEDIATELY > KHI3, JMS MONITOR STALL DGNTICK%5 JMS SETBASE JMS GET UTTY DCA KHINAM JMP KHINAM-2 KHISTP, JMS GET /STOP OUTPUT WRITER UWRTR DCA .+3 JMS MONITOR STOP 0 HLT /NAME ? NOT ? FOUND ? JMS SETBASE JMP KHILP EMTIME, CIF CDF 0 //YOU NEVER KNOW TAD I (TIME+3 //FETCH # HOURS - 24 AND C77 //THE PROBABILITY IS: 2.5 E-9 BSW // TAD I (TIME+2 //FETCH # MINUTES-60 CIF CDF 10 / TAD (3074 /DECIMAL: 2460 JMP I (EMCLA /STORE IN USERS AC: HHH.HHH.MMM.MMM PAGE /THIS ROUTINE DETERMINES WHETHER A CHAR IS IN THE CONTROL-GROUP /OR IN THE PRINTING GROUP: 211,215,233 AND 240 - 376. /IN FACT IT HAS THREE RETURNS: /1 - CHAR IS IN CONTROL-GROUP /2 - CHAR IS IN PRINTING GROUP, BUT ECHO IS DISABLED /3 - CHAR IS IN PRINTING GROUP AND ECHO IS ENABLED KHTEST, 0 /SKIP IF 'PRINTING' CHAR. TAD ZTEM1 TAD (-240 SPA JMP KHT1 TAD (240-377 SPA CLA JMP KHT2 /PRINTING GROUP; IS ECHO ENABLED ? JMP I KHTEST /CONTROL-GROUP, TAKE FIRST RETURN KHT1, TAD (240-211 SZA TAD M4 /(211-215 SZA /CARRIAGE RETURN ? TAD (215-233 SZA CLA /ESCAPE ? JMP I KHTEST /CONTROL GROUP, TAKE FIRST RETURN KHT2, ISZ KHTEST /PRINTING CHARACTER JMS GET UECHO /ECHO OR NOT ? SMA CLA ISZ KHTEST /ECHO, TAKE THIRD RETURN JMP I KHTEST KHIST, JMS SETBASE /START IN CONTROL/B MODE, R<CR> IN BUFFER KHI5, TAD BASE JMS MONITOR /CALL THE CTRLB TASK CALL "C^100+"B&3777 JMP .-3 /BUSY ? DCA ZTEM1 JMS SETBASE TAD ZTEM1 /LOOK WHAT W'VE GOT SNA JMP KHI51 /GO BACK TO NORMAL PROCESSING SPA CLA / JMS KHIOUT /ERROR "? JMP KHI21 /TRY AGAIN KHI51, TAD I BASE AND (-BGSTOP-LONG-1 DCA I BASE /CLEAR BGSTOP JMS I (EMBSINT /TEL BS WE'RE IN THE GAME AGAIN JMS GET /UNSTACK ECHO-SUPPRESS BIT UECHO CLL RAL DCA I X JMP I (KHIRUN /GO ! KHI4, JMS I (CLRQ /CLEAR INPUT AND OUTPUT BUFFERS UBUFIN JMS I (CLRQ UBUFOUT TAD I BASE AND (-LONG-1 /CLEAR LONG FOR GOOD RESPONSE DCA I BASE KHICON, JMS GET /RESTART OUTPUT WRITER UWRTR DCA .+4 TAD ZTEM1 /SAVE CHAR JMS MONITOR RESTRT 0 HLT /NAME ? NOT ? FOUND ? DCA ZTEM1 /RESTORE CHAR JMS SETBASE TAD ZTEM1 / TAD (-221 / SNA /WAS IT ^Q ? JMP I (KHILP /YES, IGNORE TAD C17 / (221-202 SZA CLA /WAS IT ^B ? JMP I (KHINRM /NO, EITHER ^C,^O : PUT IN BUFFER JMS KHIOUT /YES, PRINT ^B "^ JMS KHIOUT "B KHI21, JMS GET /STACK HIS ECHO-SUPPRESS BIT UECHO SPA CLL RAR DCA I X TAD C215 /PRINT CRLF B] JMS KHIOUT TAD C212 JMS KHIOUT JMS KHIOUT "B JMS KHIOUT 276 /THE GREATER-THAN SYMBOL TAD I BASE AND (-BGSTOP-BGERR-SWPERR-LONG-1 TAD (BGSTOP /SET BGSTOP: WE ARE IN ^B-MODE DCA I BASE JMP I (KHI /START OUTPUT WRITER AND LOOK FOR COMMAND KHIOUT, 0 /ROUTINE TO PUT ONE CHAR IN OUTPUT BUFFER SNA /CHAR IN AC ? TAD I KHIOUT /NO, GET PARAMETER JMS I (FILLQ UBUFOUT CLA CLL /FULL ! ..... JMP I KHIOUT KHI8, JMS I (CLRQ /HERE IF ERROR OCCURRED UBUFIN TAD BASE JMS MONITOR CALL "B^100+"E&3777 JMP .-3 JMS SETBASE JMP KHI21 PAGE EMFETCH,0 /FETCH (PC+(AC)) FROM USER INSTR. FIELD DCA ZTEM5 /SAVE AC JMS GET / UPC TAD ZTEM5 DCA ZTEM5 /PC+AC ISZ X /ADVANCE TO UFLDS TAD I X /GET USERS FIELD BITS JMS I (EMGETF /GET REAL FIELD (WON'T SWAP) CDTOAC //THIS MEANS THAT INST.FLD IS IN 'XACCDF' TAD I ZTEM5 //FETCH A WORD CDF 10 / JMP I EMFETCH /RETURN TO USER WITH WORD IN AC EMHAND, AC0004 /TEST FOR JMP .+4 FOLLOWING 6000 JMS I (TSTJMP / JMP I (EMERROR /IT WAS A RANDOM 6000 TAD BASE TAD (UDTV-1 /POINTER TO UDTV DCA AUTO10 AC0001 JMS EMFETCH /GET FUNCTION WORD DCA X TAD X AND C70 TAD (-BGCORE^10 SMA CLA /LEGAL FIELD ? JMP I (EMERROR /HE TRIES TO USE NON-EXISTENT MEMORY TAD X DCA I AUTO10 /STORE IN UDTV AC0002 JMS EMFETCH /GET BUFFER ADDRESS DCA I AUTO10 /STORE IN UDTV+1 AC0003 JMS EMFETCH /GET BLOCK NUMBER DCA I AUTO10 /STORE IN UDTV+2 JMP I (EMHD /DISPATCH VIA HNDTAB EMCHNL, JMS GET / UAC /GET CHANNEL NUMBER SZA CLA /SYS: ? JMP NOTSYS /NO TAD (UDTV-1 /SEE IF HE'S LOADING KBM OR CD. TAD BASE DCA AUTO10 TAD I AUTO10 AND C70 TAD I AUTO10 SNA CLA /FIELD 0, ADDRESS 0 ? TAD I AUTO10 TAD M7 SZA /READING KBM ? TAD (-51+7 SZA CLA /OR READING CD ? JMP NOTSYS /NO, NO RELEASE JMS I (EMGETF /GET FIELD 0 INCORE CDTOAC // AC2000 // AND I C7777 //IS BATCH ACTIVE IN THE BG ? CDF 10 SNA CLA / JMS I (EMREL /NO, RELEASE HIS DEVICES NOTSYS, JMS GET UAC AND C3 /GET CHANNEL NUMBER CLL RAL / *2 JMS GET /FETCH TYPE WORD UCHNL0+1 AND C7 /EXTRACT UNIT NUMBER MQL TAD I X RTL /WRITE ENABLE TO LINK SNL CLA /WRITE ENABLE ? JMP NOCHCK /YES, NO NEED TO CHECK FOR WRITE JMS GET UDTV /GET FUNCTION WORD: READ ONLY ! SPA CLA JMP EMDSK1 /THEY ARE TRYING TO FOOL US NOCHCK, JMS GET /GET FUNCTION WORD AGAIN UDTV AND C7770 MQA /ADD UNIT NUMBER DCA I X TAD I X JMS I (EMGETF /LOAD TARGET FIELD AND !LOCK! IT MQL /THATS THE REAL FIELD NUMBER JMS GET /AND ONCE AGAIN THE FUNCTION WORD CUDTV, UDTV AND (7707 /ZERO FIELD BITS MQA /OR-IN FIELD BITS DCA I X /AND RESTORE EMDSK0, JMS SETBASE /(IN CASE THIS IS A RETRY) JMS GET UAC AND C3 CLL RAL / *2 JMS GET /GET TASK NAME UCHNL0 SNA /CHANNEL OPEN ? JMP EMDSK1 /NO, ERROR ! DCA CHNDRV /NAME OF DRIVER TASK TAD BASE TAD CUDTV JMS MONITOR CALL CHNDRV, 0 /GETS TASK NAME JMP EMDSK0 /TASK BUSY, RETRY DCA .+3 JMS MONITOR WAIT 0 MQL /POSSIBLE ERROR CODE JMS SETBASE CLA MQA SZA CLA EMDSK1, AC4000 JMP I (EMCLA /STORE IN UAC AND QUIT PAGE /************************************************************ /************* O U T P U T W R I T E R **************** /************************************************************ /KHO IS A TASK, DEDICATED TO TRANSPORT CHARACTERS FROM /THE TERMINAL OUTPUT BUFFER TO THE TERMINAL. /WHEN THE BUFFER IS EMPTY, IT STOPS AND MUST BE 'RUN' KHO2, JMS MONITOR STALL DGNTICK%2 KHO, JMS SETBASE KHO1, CLA /! JMS GET UTTY SNA /DETACHED BG ? JMP KHO2 /YES, WAIT TILL ATTACHED DCA KHCALL /DRIVER NAME JMS GET UBUFOUT SNA CLA /MORE CHAR IN THE BUFFER ? JMP KHEXIT /NO, QUIT JMS I (GETQ /GET NEXT CHAR UBUFOUT /FROM OUTPUT BUFFER AND (377 /ONLY 8 BITS JMS MONITOR /AND PUT IT OUT CALL KHCALL, T1TCBP /NAME OF OUTPUT TASK JMP KHO2 /OUTPUT TASK BUSY:LOOP JMS SETBASE KHLT, JMS I (MTQ /NOW REMOVE THE CHAR FROM THE BUFFER UBUFOUT SKP CLA /EMPTY, EXIT JMP KHO1 KHEXIT, JMS MONITOR /HALT THE OUTPUT WRITER EXIT /CHANNEL ASSIGNMENT ROUTINE /THIS ROUTINE IS CALLED VIA A GIANT IOT(5) /PARAMETERS FROM THE BACKGROUND: / / CHANNEL NUMBER 0-3 / TASK NAME / DEVICE TYPE AND UNIT NUMBER EMOPEN, AC0001 JMS I (EMFETCH /GET CHANNEL NUMBER DCA ZTEM1 / AC0002 JMS I (EMFETCH /GET DRIVER TASK NAME DCA ZTEM2 / AC0003 JMS I (EMFETCH /GET TYPE AND UNIT NUMBER DCA ZTEM3 / TAD ZTEM1 AND (7774 SZA CLA /MUST BE 0-3 JMP I (EMERROR TAD ZTEM1 CLL RAL TAD BASE TAD (UCHNL0-1 /INDEX CHANNEL TABLE DCA AUTO10 TAD ZTEM2 DCA I AUTO10 /ENTER TASK NAME IN WORD 0 TAD ZTEM3 DCA I AUTO10 /ENTER TYPE IN WORD 1 JMP I (EMCLA /CLEAR USER AC AND RETURN IFDEF DKUSED < /THIS TASK PERFORMS THE CONVERSION BETWEEN A VIRTUAL DISK /REQUEST AND A TRUE PHYSICAL DISK REQUEST. IT MAY BE CALLED /AS AN ORDINARY BLOCKTRANSFER MODULE (WITHOUT QUEING) /AND WILL TRANSFORM THE CALLERS REQUEST ACCORDING TO THE /DEFINITIONS FOUND IN 'DSKTAB', WHICH SHOULD BE IN FIELD 1 AND /MUST BE SETUP BY THE POWERUP SEQUENCE. DSKTAB SHOULD CONTAIN /EIGHT ENTRIES OF FOUR WORDS EACH DESCRIBING A VIRTUAL DISK /LAYOUT OF EACH ENTRY: / /WORD 0: NAME OF HANDLER TASK /WORD 1: BITS 9-11=PHYSICAL UNIT NUMBER /WORD 2: RELATIVE BLOCK # 0 /WORD 3: LAST BLOCK+1 (PHYSICAL) / /IF THE TRANSFER GOES ACROSS THE BOUNDS OF THE VIRTUAL DISK, /THE TRANSFER IS NOT DONE AND A HARDERR STATUS IS RETURNED. DK, SNA /CLOSE ? JMP DKCLOSE DCA ZTEM1 /POINTER TO USERS DTV TAD I ZMYCDF /CDF TO USERS DTV, USED TO INITIALIZE DCA DKCDF /CDF-USER ROUTINE TAD I ZTEM1 /FETCH FUNCTION WORD AND C7 /EXTRACT UNIT NUMBER DCA ZTEM5 TAD ZTEM5 CLL RTL /MULTIPLY BY 4 TAD (DSKTAB-1 /INDEX IN DISK DESCRIPTOR TABLE CDF 10 /DSKTAB IS IN FIELD 10 DCA AUTO10 / TAD I AUTO10 /FIRST WORD CONTAINS TASK NAME SNA /IS THIS UNIT DEFINED ? JMP DKERROR /NO, ZERO NAME IS ILLEGAL DCA DKNAME /NAME OF HANDLER TASK TAD I AUTO10 /GET WORD 1 DCA DKDTV /BUILD A NEW DTV, THIS IS THE TRUE UNIT # DKCDF, HLT /CDF TO CALLERS FIELD TAD I ZTEM1 /GET REST OF USERS FUNCTION WORD AND C7770 /MASK OF UNIT # TAD DKDTV /GET TRUE UNIT # DCA DKDTV /THIS IS THE FINAL FUNCTION WORD ISZ ZTEM1 /BUMP POINTER TO USERS DTV TAD I ZTEM1 /GET USERS BUFFER ADDRESS DCA DKDTV+1 ISZ ZTEM1 TAD I ZTEM1 /GET VIRTUAL BLOCK # CDF 10 TAD I AUTO10 /ADD OFFSET TO OBTAIN PHYSICAL BLOCK # DCA DKDTV+2 /AND STORE IT IN DKDTV TAD DKDTV /NOW CHECK IF WHOLE TRANSFER AND C3700 /IS WITHIN THE RANGE. GET LENGTH SNA AC4000 BSW IAC RAR /MAKE # BLOCKS CLL TAD DKDTV+2 /ADD START BLOCK # CIA TAD I AUTO10 /ADD MAXIMUM ALLOWED SNL CLA /OVERFLOW ? JMP DKERROR /YES, TRANSFER OUT OF RANGE JMS MONITOR /NOW RESERVE A SLOT FOR THE USER TO WAIT /LET CALLER CONTINUE WITH SLOT # IN AC RESERV RETURN CONTINUE DCA DKSLT2 / CDTOIF TAD (DKDTV /GET POINTER TO DKDTV JMS MONITOR CALL /CALL SYSTEM HANDLER DKNAME, "S^100+"Y&3777 JMP .-3 /BUSY ? DCA DKSLT1 JMS MONITOR WAIT DKSLT1, 0 JMS MONITOR /PASS STATUS TO USER SIGNAL HALT CLEAR DKSLT2, 0 DKERROR,TAD (-HRDERR DKCLOSE,TAD M1 / JMS MONITOR EXIT DKDTV, ZBLOCK 3 /HERE THE TRANSFER VECTOR IS BUILD /END IFDEF DKUSED > PAGE /THIS IS THE QUEUE HANDLING PACKAGE FOR THE MULTI8 /TERMINAL IO QUEUES. IT IS BASED ON THE USAGE OF A POOL OF /BLOCKS OF 2^N WORDS EACH. THESE BLOCKS ARE USED TO STORE /2^N-1 CHARACTERS AND A POINTER TO THE NEXT BLOCK IN THE QUEUE. /EACH QUEUE IS BASED ON A THREE-WORD DESCRIPTOR: / /COUNTER: CONTAINS THE NUMBER OF CHARACTERS IN THE QUEUE /READP: POINTER TO THE START OF THE FIRST BLOCK IN QUEUE /WRITEP: POINTER TO THE LAST BLOCK IN THE QUEUE / /WHEN THE QUEUE IS FILLED, ADDITIONAL BLOCKS MAY BE LINKED TO /IT. THESE BLOCKS ARE OBTAINED FROM A QUEUE AT LOCATION 'FREE'. /ON READING CHARACTERS FROM THE QUEUE, EMPTY BLOCKS ARE RETURNED TO /THE FREE LIST, EXCEPT FOR THE LAST BLOCK, WHICH IS NEVER RELEASED. /THE PACKAGE CONTAINS 4 ROUTINES: / /FILLQ: ENTERS ONE CHARACTER IN THE QUEUE /MTQ: REMOVES ONE CHAR FROM THE QUEUE /GETQ: GETS THE NEXT CHARACTER FROM THE QUEUE, WITHOUT / REMOVING IT /CLRQ: ZERO'S A QUEUE / / ***** NOTE ***** / ONLY FILLQ AND MTQ ARE CROSS-FIELD CALLABLE / XCOUNT=MTQ XREADP=GETQ XWRITEP=CLRQ IFZERO BGMAX-1 < BSIZE=40 FMASK=C37 POOLN=2 > IFZERO BGMAX-2 < BSIZE=40 FMASK=C37 POOLN=4 > IFZERO BGMAX-3 < BSIZE=20 /BLOCK SIZE, MUST BE 2^N FMASK=C17 /ADDRESS FOR MASK POOLN=10 /NUMBER OF BLOCKS IN THE POOL > IFZERO BGMAX-4 < BSIZE=20 FMASK=C17 POOLN=20 > IFZERO BGMAX-5 < BSIZE=10 FMASK=C7 POOLN=40 > IFNZRO 5-BGMAX&4000 < BSIZE=10 FMASK=C7 POOLN=100 > FILLQ, 0 /ENTER WITH CHAR IN AC MQL /STORE FOR A WHILE TAD FILLQ /CALL COMMON SETUP CODE JMS SETUP / IAC / DCA XWRITEP / TAD I XWRITEP /SETUP POINTER TO STORE DCA X /THE CHARACTER CLA MQA /STORE CHAR IN THE BUFFER DCA I X / AC0001 / TAD X /GET POINTER TO NEXT LOCATION AND FMASK / SZA CLA /PAST END OF BLOCK ? JMP FILLQ1 /NO, NO PROBLEMS THIS TIME TAD FRECNT /GET NUMBER OF FREE BLOCKS IFZERO BSIZE-10 < CLL RTL;RAL > IFZERO BSIZE-20 < CLL RTL;RTL > IFZERO BSIZE-40 < CLL RTL;RTL;RAL > CIA / TAD FRECNT /1 PLACE IN BLOCKLET IS POINTER TAD I XCOUNT /SEE IF WE HIT THE MAXIMUM ALLOWED SMA CLA /TOO MUCH ? JMP FERROR /YES, ERROR RETURN TAD X /YES, BACKUP TO BEGIN OF BLOCK AND (-BSIZE / DCA X / TAD FREE /POINTER TO FIRST BLOCK ON FREE CHAIN SNA /FREE QUEUE EMPTY ? JMP FERROR /YES, SORRY DCA I X /NO, PUT ADDRESS OF FREE BLOCK IN LAST TAD FREE /BLOCK AND PREPARE X FOR WRITEP DCA X / TAD I FREE / DCA SETUP /POINTER TO NEXT FREE BLOCK DCA I FREE /ZERO LINK OF NEW BLOCK TAD SETUP /GET POINTER TO NEXT FREE BLOCK DCA FREE /AND SET FREE ACCORDINGLY ACM1 TAD FRECNT /REDUCE COUNTER FOR FREE QUEUE DCA FRECNT / FILLQ1, AC0001 / TAD X /NOW USE X TO DCA I XWRITEP /SET NEW WRITE POINTER ISZ I XCOUNT /INCREMENT CHARACTER COUNT MQL /RETURN WITH AC=0 FNORML, ISZ FILLQ /TAKE OK RETURN FERROR, CLA MQA /FOR ERROR, RETURN WITH CHAR IN AC FRETRN, CDF CIF JMP I FILLQ /THATS IT MTQ, 0 /READ ONE CHAR FROM THE QUEUE TAD MTQ /CALL COMMON SETUP CODE JMS SETUP / DCA XREADP / TAD I XREADP /FETCH THE CURRENT CHARACTER DCA X / TAD I X /THERE IT IS MQL /STORE AWAY FOR LATER DCA I X /CLEAR BUFFER TAD I XCOUNT /CAN WE ADVANCE THE POINTER ? SNA CLA / ? JMP FRETRN /NO, GO BACK WITH NULL ISZ I XREADP /ADVANCE READ POINTER TAD I XREADP /SEE IF W'RE PAST THE END OF THE BLOCK AND FMASK SZA CLA /PAST END OF BLOCK ? JMP MTQ1 /NO TAD I XREADP /YES, BACKUP POINTER TO BEGIN OF BLOCK TAD (-BSIZE / DCA X / TAD I X /GET ADDRESS OF NEXT BLOCK IAC /ADVANCE POINTER TO FIRST CHAR POSITION DCA I XREADP /ADDRESS OF NEW BLOCK TAD FREE / DCA I X / TAD X DCA FREE / ISZ FRECNT /INCREMENT NUMBER OF FREE BLOCKS MTQ1, ACM1 /BACKUP CHARACTER COUNT TAD I XCOUNT DCA I XCOUNT / JMP FNORML /AND RETURN WITH CHAR IN AC GETQ, 0 /FETCH THE CURRENT CHARACTER AC0001 /READP=UBUFXXX+1 TAD I GETQ /GET PARAMETER ISZ GETQ /FOR NORMAL RETURN TAD BASE / JMS DEFER /GET POINTER TO CHARACTER JMS DEFER /GET THE CHARACTER JMP I GETQ /RETURN WITH CHAR IN AC CLRQ, 0 /ZERO A QUEUE TAD CLRQ JMS SETUP /CALL COMMON SETUP CODE DCA XREADP / CLRQ1, TAD I XREADP /MAKE POINTER TO FIRST BLOCK IN QUEUE AND (-BSIZE JMS DEFER /GET POINTER TO NEXT BLOCK SNA /NIL, THEN THIS IS A ONE-BLOCK QUEUE JMP CLRQ2 /YES, DON'T DEALLOCATE THE LAST BLOCK DCA I XREADP /STORE POINTER TO NEXT BLOCK TAD FREE / DCA I X /LINK OLD BLOCK TO FREE TAD X / DCA FREE /AND SET SET FREE TO THIS ONE ISZ FRECNT /RETURN 1 BLOCK TO FREE QUEUE JMP CLRQ1 /GO ON FOR MORE BLOCKS CLRQ2, ISZ X /SET READP TO FIRST CHARACTER POSITION TAD X /POINTER TO FIRST BLOCK DCA I XREADP /NEW READP ISZ XREADP /ADVANCE TO WRITEP TAD X / DCA I XREADP /SET WRITEP=READP DCA I XCOUNT /SET COUNT=0 JMP FRETRN /RETURN SETUP, 0 /SETUP POINTERS FOR QUEUE ROUTINES DCA FILLQ /ALL RETURNS THROUGH FILLQ TAD I ZMYCDIF /GET RETURN CIF CDF DCA FRETRN /PREPARE RETURN TO USER FIELD TAD I FILLQ /GET PARAMETER ISZ FILLQ / TAD I (BASE /ADD HIS (!) BASE CDF 10 /SELECT THE FIELD OF BUFFERS DCA XCOUNT /POINTER TO COUNT TAD XCOUNT / IAC /POINTER TO READP IN AC JMP I SETUP PAGE /END IFNZRO BGMAX >