File M3.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/******** TOPS-8 MONITOR (M3) ********
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
IFNZRO BGMAX-1 <
INCORE=1000	/REQUEST FROM EMUL. TO "BS" TO MOVE BG IN CORE

ONDISK=400	/IF SET THE BG IS NOT IN CORE

LONG=200	/SET IF BG NEEDS MORE THAN A SHORT SLICE >

BGSTOP=100	/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

NOBOOT=20	/SET IF BOOT NOT PERMITTED (E.G. DURING DECTAPE
		/TRANSFERS)

BGBLOK=10	/THIS BIT IS USED TO PREVENT A BG N AND WORK. THE TASK, WHLL HAVE TO CLEAR IT PRET BY EMULATOR IN CASE OF  BRINGS INPUTREADER IN ^B-MODE.

LOGOUT=2	/THIS BIT SIGNIFIES THAT THE USER HAS LOGED OUT
		/AND SHOULD LOGIN BEFORE GETTING ANYTHING DONE

SWPERR=1	/SET WHEN A DISK ERROR OCCURS DURING
		/A SWAP OPERATION

E4
EMUPC=ZTEM3
EMUFLD=ZICK^4%12	/SAMPLE FREQUEN DELAY <DELAY=1>

/IF ATHINKS ITS TIME TO DO SOME /BG COMPUTATIONS. THUS WE LOAD THE BG REGISTERS AND RUN AWAY. DISP3, IFNDEF EAE < IFNZRO PDPTYP-PDP8E <AC0002>> TAD BJOB / DCA AUTO14 / IFDEF EAE < TAD I AUTO14 /FETCH MQ IFZERO PDPTYP-PDP8E < SWAB /LOAD MQ;SET MODE B AC4000 / TAD I AUTO14 /FETCH STEPCOUNTER, FLIPS MODE TO LINK ASC /LOAD STEPCOUNTER FROM AC SNL /OVERFLOW FROM MODE-BIT? SWBA /SET MODE A> IFNZRO PDPTYP-PDP8E < MQL /LOAD MQ TAD I AUTO14 /FETCH STEPCOUNTER CMA /STRANGE HARDWARE NEEDS COMPLEMENT DCA .+2 / SCL /LOAD STEPCOUNTER FROM .+1 0 />> IFNDEF EAE < IFZERO PDPTYP-PDP8E < TAD I AUTO14 /FETCH MQ FROM CORE MQL /LOAD MQ ISZ AUTO14 /SKIP STEPCOUNTER>> TAD I AUTO14 /FETCH PC IOF /// ISZ CURTSK ///MAKE CURTSK POSITIVE DCA 0 ///SET UP FOR RETURN TAD I AUTO14 ///FETCH FIELDS +LINK ETC. IFZERO PDPTYP-PDP8E < IFDEF MEMMNG <TAD (-BGFLD%10!7000-BGFLD > IFDEF FYSUNTRP <TAD (-BGFLD%10!7000-BGFLD > DCA INTFLD ///PUPT EXIT TAD I AUTO14 /// IFDEF KM8E < TAD ALSO COME HERE AFTER FASN. TAD INTAC JMP I 0 /// >/END OF KM8E IFNDEF KM8E < JMP I (INTEXT /// GO !>>/END OF PDP8E IFNZRO PDPTYP-PDP8E < DISP3A, DCA INTFLD ///NON-8E LACKS RTF INSTRUCTION TAD INTFLD ///COMPUTE CDF INSTR. AND C CLL RTL /// RAL //F DCA BGCDF /// TAD /EXTRACT INSTRUCTION FIEYCIF///MAKE CIF > IFNZRO MONFLD <TAD (6202///MAKE CIF > DCA BGCIF /// TAD INTFLD /// RAL ///LOAD LINK CLA /// SUF ///SET USER MODE TAD I AUTO14 /// BGCDF, 0 /// BGCIF, 0 /// ION /// JMP I 0 ///AT LAST WE GO> RSAVE, 0 ///SAVE FULL INTERRUPT STATUS IFNDEF EAE < IFNZRO PDPTYP-PDP8E <AC0002>> TAD BJOB /// DCA AUTO13 /// IFDEF EAE < SCA ///OR-IN STEPCOUNTER SWP ///SWAP AC AND MQ DCA I AUTO13 /// IFZERO PDPTYP-PDP8E < / MODE A MODE B SCL ASC 7330 AC4000 MQA ///M00.000.0SS.SSS, M=MODE B > DCA I AUTO13 ///> IFNDEF EAE <IFZERO PDPTYP-PDP8E < SWP /// DCA I AUTO13 /// ISZ AUTO13 ///>> TAD 0 ///PC DCA I AUTO13 /// TAD INTFLD /// IFDEF MEMMNG <TAD (BGFLD%10+BGFLD > IFDEF FYSUNTRP <TAD (BGFLD%10+BGFLD > IFNZRO PDPTYP-PDP8E <RIB> /// DCA I AUTO13 ///LINK+USERFLOP+DF+IF TAD INTAC /// DCA I AUTO13 /// JMP I RSAVE ///
/*********************************************************** A L E M U L A T O R ************************** TRAPINT,CINT ///CFLAG IFDEF KM8E < RIB /TAD INTFLD (FOR PDP8E GTF WILL DO AS WELL) AND C70 ///USERS INSTR. FIELD TAD C6201 ///MAKE CDF USERS FIELD DCA BGCDF1 ACM1 TAD 0 ///GET PC OF TRAPPING INSTR. DCA X BGCDF1, HF. TAD I X ///GET HIS RTR TAD (-1310 ///IF SZA CLA ///AND LINK IP EMNCDF IFNZRO PDPTYP-PDP8E < CDF MONFLD TAD (INTAC-1 ///SET AUTO14 FOR DISP3A DCA AUTO14 RIB /// > TAD INTFLD ///GET HIS LINK, UM AND FIELD-BITS AND C7770 IFZERO BGFLD-10 <IAC /TAD (BGFLD%10 > IFZERO BGFLD-20 <TAD C2 /(BGFLD%10 > IFZERO BGFLD-30 <TAD C3 /(BGFLD%10 > IFZERO BGFLD-40 <TAD C4 /(BGFLD%10 > IFNZRO BGFLD-10&7747 <BGFLDR,XERROR > SNL ///LINK HAS CHANGED BY TAD (-1310 IAC JMP DISP3A ///THE REST IS TOO TROUBLESOME EMNCDF, TAD I X ///GET INSTRUCTION AGAIN CDF MONFLD DCA MONITOR ///USE AS TEMPORARY SAVE >/END OF KM8E JMS RSAVE ///"FIRST" SAVE ALL REGISTERS TAD BJOB /// TAD (UCUR /// DCA X ///SET UP POINTER TO THIS EMULATORS CURTSK TAD I X /// ION /// DCA CURTSK /// TAD BJOB /BJOB SAYS WHICH BG DCA BASE / AC2000 /TAD (EMULATE IFNZRO EMULATE-2000 <EMULER,XERROR> TAD I BASE DCA I BASE /SET EMULATE.
TAD BASE TAD C3 /(UPC DCA EMUPC /PREPARE POINTER TO UPC AC0001 TAD EMUPC DCA EMUFLD /PREPA AC0001 TAD EMUFLD TER TO UAC AC0001 TAFDEF KM8E < TAD MONITOTRUCTION > IFNDEF KM8E < ACM1 /GET THE ROTTEN INSTRUCTION JMS I (EMFETCH /WHICH GETS INTO UINST > IFDEF MEMMNG < 6205 /READ TRAP REGISTER > DCA I EMUINST /STORE INSTRUCTION IN DATAAREA EM1, AC2000 /TAD (-IOT TAD I EMUINST /IS IT A IOT? AND C7000 SZA JMP I (DOHLT /WHICH IOT? USE THE DISPATCH LIST TAD I EMUINST /6XY. RTR RAR /.6XY AND C77 /00XY TAD (EMTAB EM2, DCA ZTEM1 /POINTER IN TABLE EM3, TAD I ZTEM1 CIA /WE WANT THIS ANYWAY SPA SNA JMP I (EMCALL /POSITIVE = NAME OF EMULATOR TASK /EMULATE THE IOT DIRECTLY EMDOT, TAD (. /NEGATIVE: -ADDRESS+EMDOT DCA ZTEM1 /EMDOT+DIFFERENCE=ADDRESS JMP I ZTEM1 /JUMP TO RESIDENT EMULATOR ROUTINE IFDEF KM8E < /HERE BEGINS THE REAL KM8E-STUFF PAGE
EMCDIF, TAD I EMUINST /EMULATE 620X & 621X AND C4 SZA CLA /IS IT 6204/6214 OR THAT KIND ? JMP I (EMFOUR /Y; HELP HIM DCA EMCNT /COUNT THE NUMBER OF INSTR. FROM NOW ON JMS EMCDI /EMULATE CDF, CIF AND EVERYTHING JMP I (EMRENEXT JMS/JMP. EMCDI, , BECAUSE WE TAD I EMU& CIF BETWEEN TAD (BGFMP OR JMS. AND C70 /ADD RELOCATION, MASK FIELD BITS DCA ZTEM1 /SAVE NEW FIELD TEMPORARY TAD I EMUINST RTR /MOVE BIT 10 TO LINK, AND 11 TO 0 SMA CLA /IS IT A CDF ? JMP EMNOCDF /NO TAD I EMUFLD /YES, LD. AND C7770 /CLEAR B TAD ZTEM1 /GET NEW DA /SAVE LINK THROUGH ROTAAD X DCA I EMUFLD /END OF CDF EMULATION EMNOCDF,SNL CLA /IF LINK = 1, A CIF, THAT MEANS TROUBLE ! JMP I EMCDI /NO CIF, LUCKY US, NOW HURRY ! TAD I EMUFLD /HERE WE GO AND C70 /HE'D BETTER DO A JMP VERY FAST, CIA /OR ELSE IT WILL TAKE A LOT OF TIME TAD ZTEM1 /(WHICH IT WILL ANYWAY) SNA CLA /DOES THE FIELD REALLY CHANGE ? JMP I (EMREDY /NO, WHY MAKE TROUBLE ? TAD ZTEM1 DCA BGIFLD /SAVE NEW INSTR. FIELD IN BUFFER /FROM HERE WE FIND OUT WHICH INSTRUCTION AND /EMULATE ALL INSTRUCTIONS THAT ARE NORMALLY NOT TRAPPED. EMPCIF, JMS I (EMFETCH /FETCH NEXT INSTRUCTION DCA I EMUINST /STORE IT AWAY. /WE DIDN'T YET INCREMENT THE PC, BUT DON'T WORRY, WE WILL! ISZ EMCNT /HOW MUCH INSTRUCTIONS AFTER THE CIF ? SKP /LESS THAN 4096 JMP I (EMERROR /SOME STUDENT IS TRYING TO FOOL US
TAD I EMUINST /DETECT WHICH INSTRUCTION. SMA JMP I (EMMRI /0000-3777 CLL RTL SNL JMP JMSJMP /4000-5777 ISZ I EMUPC /DON'T FORGET! SPA /NEVER TRUSJMP EMIOT /6000-6777 (IOR) SNL /WHICH GROUP ? AND (160 /GROUP 2 OR 3HLT OR GROUP 3 OPR ? JMP I (EMERROR /WHO WRITES SUCH AFTER A CIF ? TAD I EMUINST /REST OF OPR'S: JMP I (EMSELF /EXECUTE IT, WHATEVER IT IS EMGRP1, RTR RTR /INSTRUCTION BACK IN AC JMP I (EMSELF /EXECUTE ITRUCTION AGAIN IN AC JFFECTIVE ADDRESS. /E1 TAD I EMUFLD /NOW TH AND (7707 /WE'VE LONGED FOR ALL THIS TIME, TAD BGIFLD /WE FIRST MAKE THE FIELD OK. DCA I EMUFLD TAD I EMUINST /INSTRUCTION AGAIN. AND (1000 /IS IT A JMS OR A JMP ? SZA CLA JMP EMJMP /A JMP: EASIER TAD BGIFLD TAD C6201 /NOW CDF TO NEW INSTR. F. DCA .+3 AC0001 TAD I EMUPC /PUT CALLING ADDRESS+1 INTO SUBR. HLT //CDF NEW IF. DCA I ZTEM1 //SET CALLING ADDR+1 IN SUBR. ADDR. CDF MONFLD AC0001 /SET PROGRAM COUNT TO SUBR. ADDR+1 EMJMP, TAD ZTEM1 DCA I EMUPC /CHANGE PROGRAM COUNT JMP I (EMREDY /AND NOW WE ARE REALLY READY. BGIFLD, BGFLD /SOFTWARE "INSTRUCTION BUFFER" EMCNT, 0 /PREVENT FROM BOMB-PROGRAMS
EMIOT, AND (-BGFLDS^40+21 /IS IT CDF/CIF 0 OR 1 ? TAD (-1001 /THEN NOW WE ARE ZERO SZA CLA JMP I (EMERROR /THE REST WE DON'T ALLOW JMS EMCDI /RECURSIVE SUBROUTINE CALL. THIS IS JMP EMPCIF /POSSIBLE, AS WE NEVER RETURN FROM /THE FIRST LEVEL WITH "JMP I EMCDI" /AFTER BEING ON THE SECOND LEVEL. EMEXEC, TAD I ETOR FOR DISPLAYS ETC. N AHEAD TAD I EMUAC /LHLT /USERS INSTRUCTION SKIP ISZ I EMUPC /SKIPPED: INCREMENT UPC NOP /NEVER TRUST A USER DCA I EMUAC /RESTORE HIS ACCUMULATOR JMP I (EMREDY /THAT'S IT PAGE EMADRES,0 /SUBR TO COMPUTE THE EFFECT. ADDR. AND C177 /ENTERED WIDCA ZTEM1 /RETURN WITH A EMUINST AND C200 /0 O AND I EMUPC TAD ZTEMO IN AC DCA ZTEM1 TAD I EMUINST AND (400 SNA CLA /INDIRECT BIT SET ? JMP I EMADRES /NO, DIRECT
TAD I EMUFLD AND C70 TAD C6201 DCA MRIIND /CDF USERS INSTR. F. TAD ZTEM1 /ADDRESS TAD M10 /AUTOINDEX ? AND C7770 MRIIND, HLT //CDF USERS IF. SNA CLA ISZ I ZTEM1 //YES, INCREM. FIRST, CAN'T SKIP TAD I ZTEM1 CDF MONFLD DCA ZTEM1 /EFFECTIVE ADDRESS IN ZTEM1 JMP I EMADRES EMMRI, JMS EMADRES /FETCH THE EFFECTIVE ADDRESS ISZ I EMUPC /DON'T FORGET NOP /PREVENT FROM SKIP TAD I EMUINST /THE INSTRUCTION AGAIN CLL RTL RTL /INDIRECT-BIT TO LINK. CLA TAD I EMUFLD SNL /INDIRECT OR DIRECT ? JMP EMDIR /DIRECT. RTL RAL /THIS TIME WE NEED THE DATAFIELD EMDIR, AND C70 TAD C6201 /CDF USERS INSTR./DATAFIELD DCA MRIFLD /WE HAVE CORRECT FIELD IN MRIFLD TAD I EMUINST /AND ADDRESS IN ZTEM1 AND C7000 TAD (400+ZTEM1 /MAKE INDIRECT INSTRUCTION. EMSELF, DCA MRINST /WE ALSO COME HERE FOR OPR'S TAD I EMUFLD CLL RALD THE LINK NOW TAD I ED //NOT DANGEROUS FOR OP //EMULATE ! JMP .+3 LD /MUST BE DONE BEFORE SKIP ISZ I EMUPC /BECAUSE OF INDIRECTION CDF MONFLD /NO WORRY IF ISZ SKIPS THIS ONE DCA I EMUAC /SAVE AC ETC. TAD ZTEM5 RAR DCA I EMUFLD JMP I (EMPCIF /EMULATE NEXT INSTRUCTION. BGCDIF, 0 /FOR BO,BS AND CB TAD I ZMYCIF CDF MONFLD DCA BGRET TAD BJOB TAD (UFLDS DCA MONITOR /DON'T USE X (FOR BS) TAD I MONITOR AND C70 TAD C6201 DCA I (BGCDF1 BGRET, HLT /CIF CALLING FIELD JMP I BGCDIF /DATAFIELD REMAINS MONFLD!
EMRDF, TAD I EMUFLD RTL RAL /GET DATAFLD SKP EMRIF, TAD I EMUFLD /EMULATE RIF AND C70 /MASK FIELD BITS TAD (-BGFLD /DON'T TELL HIM THE TRUTH JMP I (EMOR /COMBINED "OR INTO AC" PIECE >/END OF THE REAL KM8E STUFF EMFOUR, TAD I EMUINST /EMULATOR FOR 62X4-INSTR. CLL RTR SPA SZL /SKIPS ONLY IF BIT 10 AND 11 OF JMP I (EMFRED /INSTRUCTION ARE ZERO. RAR SNL /NOW ONLY SKIP IF IT IS 62X4 JMP I (EMFRED /WE FORGOT TO CLEAR THE AC AND C7 /MASK X-BITS TAD (JMP I EM4TAB DCEMERROR /6204 CINT IFDEDF EMRIF /6224 RIF > /6214 RDF EMERROR /622RIB EMERROR /6244 RMF EMSKIP /6254 SINT, WORKS AS "SKIP-ON-TOPS-8". EMSPY /6264 CUF, WORKS AS "LOOK-IN-MONFLD" EMERROR /6274 SUF PAGE
EMLAST, 0 /NAME OF LAST CALLED TASK EMCALL, SNA JMP I (EMREDY /NEMLAST /EQUAL TO LAST NA10 /Y;DO NOT REPLACE NAMCE NAME EM9, DCA EMNAME,LAST NAME DCA EMLAST EM10, TAD BASE /TELL THE TASK FOR WHOM IT WORKS JMS MONITOR CALL EMNAME, 0 /NAME, REPLACED BY TCBP JMP EMWAIT /IF TASK BUSY: TRY AND TRY ... EM11, SZA CLA /DETECTED ERROR WHEN AC UNEQ 0 JMP I (EMERROR EMWHO, JMS I (SETBASE /FOR WHICH BG?AC=0;DF=MONFLD JMP I (EMREDY EMWAIT, DCA BASE /WE FORGOT BECAUSE OF THE CALL TAD EMNAME /FETCH TCBP OF BUSY TASK IFZERO BGMAX-1 <SMA CLA /NAME OR TCBP ? JMP I (EMERROR /NAME! COULDN'T FIND IT ! > IFZERO BGMAX-2&4000 < SMA /NAME OR TCBP ? JMP I (EMERROR /NAME! COULDN'T FIND IT ! JMS I (PUT /AND STORE IN UCOMM UCOMM > JMS I (EMINACT /DEACTIVATE BG EMW1, JMS MONITOR /AND WAIT ... STALL DGNTICK%12 JMS I (SETBASE TAD I BASE AND (BGSTOP SZA CLA /SEE IF USER HAS MORE PATIENCE JMP I (EMREDY /NO, DON'T WAIT ANY LONGER IFZERO BGMAX-1 <TAD EMNAME /NOONE CAN HAVE TOUCHED THIS > IFZERO BGMAX-2&4000 < JMS I (GET UCOMM > TAD M4 /GET PNTR TO BACKLEFER /GET HIS BACKLINK NOW ? TAD CURTSK /COMLA /OR IS HE FREE FOR MERO BGMAX-1 < JMS I (EMACTIV /YES, ACTIVATE BG JMP EM10 >
IFZERO BGMAX-2&4000 < TAD CURTSK /YES, CLAIM HIM ! DCA I X TAD (INCORE /REQUEST BS TO BRING HIM IN CORE JMS I (EMACTIV /ACTIVATE BG JMS I (GE JMS MONITOR /WAIT TILL 0 JMS I (SETBASE JT TCBP OF TASK WE WERE A TO MAINSTREAM PROCESSING /COPY UCOMM INTO EMNAME AND EMLAST > DOHLT, TAD M1000 /=-OPR+IOT SZA CLA /MUST BE OPERATE INSTRUCTION JMP I (EMERROR /SPURIOUS TRAP (HLT SKP ?) TAD I EMUINST /FETCH INSTRUCTION TAD (-OSR SNA JMP DOOSR TAD M200 SZA CLA JMP I (EMERROR DCA I EMUAC /CLEAR UAC DOOSR, JMS I (GET USW /GET USERS VIRTUAL SWITCH REGISTER JMP I (EMOR EMCLEAR,TAD I EMUINST /FETCH INSTRUCTION AND C7 /IS IT REALLY A 6000? SNA JMP I (EMHAND /6000 IS HANDLER CALL TAD (-2 SNA /IOF ? JMP I (EMREDY /LET HIM GO IFNDEF FYSUNTRP < TAD M4 /IS IT A 6006 (SGT) ? SZA CLA / > JMP I (EMERROR /NO IFNDEF FYSUNTRP < IFNDEF EAE < JMP I (EMREDY /YES, BUT NO FLAG, SO NO SKIP > IFDEF EAE < JMP I (EMSGT /YES >>
EMREL, 0 /ROUTINE TO RELEASE ALL CLAIMED DEVICES TAD I (DATE CDF BGFLD+10 // DCA I (OS8DATE //STORE SYSTEM DATE IN OS8 IFNZRO BGFLDS-3&4000 < CDF MONFLD > IFZERO BGFLDS-3&4000 < CDF BGFLD TAD I C7777 /IS CDF MONFLD RAL SPS, DON'T RELEASE > JMS UECHO TAD (ASEMTB /WIST JMS I (PUT /OF ASSIGNABLE EMULATOR TASKS UCOMM /IN UCOMM EMLOOP, JMS I (GET UCOMM ISZ I X /BUMP UCOMM JMS DEFER /FETCH NAME FROM ASEMTB SNA JMP I EMREL /ZERO ENDS THE LIST DCA .+3 JMS MWITH AC=0 RUN /THE 0 NOP JMS I (SETE
EMGIGA, TAD I EMUAC ODE CLL TAD (-GIGAMX SZL CLA /LESS THAN MAX. ? JMP I (EMERROR /NO, OUT OF RANGE TAD I EMUAC /GET UAC TAD (GIGATB /FUNCTIONS ARE DEFINED IN GIGATB, /WHICH HAS THE SAME ENCODING AS EMTAB JMP I (EM2 IFDEF DAYTIM < EMTIME, TAD I (TIME+3 /FETCH # HOURS - 24 AND C77 IFZERO PDPTYP-PDP8E <BSW> IFNZRO PDPTYP-PDP8E < CLL RTL RTL RTL /> TAD I (TIME+2 /FETCH # MINUTES-60 TAD (3074 DCA I EMUAC /STORE IN USERS AC: HHH.HHH.MMM.MMM JMP EMREDY /> IFNDEF FYSUNTRP < IFDEF EAE < EMSGT, TAD I EMUFLD /GREATER THAN FLAG IS IN FLAG-WORD RAL /BIT 1: TEST IT SPA CLA /MUST IMMEDIATELY PRECEDE EMSKIP >> EMSKIP, ISZ I EMUPC /SINT WORKS AS SKIP ON TOPS-8 EMFRED, CLA /PROTECT ISZ: NEVER TRUST A USER ! EMREDY, TAD (-INACTIVE-EMULATE-NOBOOT-1 /CLEAR STATUS AND I BASE DCA I BASE IFZERO BGMAX-1 < JMP I ZDISPATCH > IFNZRO BGMAX-1 < TAD BSFLAG /BG SCHEDULER RINGING? SNA CLA JMP I ZDISPATCH DCA BSFLAG /Y;CLEAR THE REQUEST TAD ZDISPAHE BS WE'RE READY > E)) FROM USER INSTR. FIELEM5 TAD I EMUFLD /GET 70 /INSTRUCTION FIELD TAD C6201 /MAKE A CDF DCA .+1 / CDF // TAD I ZTEM5 //FETCH A WORD CDF MONFLD / JMP I EMFETCH /RETURN TO USER WITH WORD IN AC
EMACTIV,0 /MAKE BG ACTIVE TAD I BASE TAD (-INACTIVE+EMULATE /CLEAR INACTIVE, SET EMULATE IFZERO BGMAX-1 < DCA I BASE JMP I EMACTIV > IFZERO BGMAX-2&4000 < AND (-LONG-1 /WE'RE NOT CPU-BOUND NOW DCA I BASE TAD EMACTIV JMP EMBSI1 /GO KICK BG-SCHEDULER > EMINACT,0 /ROUTINE TO DEACTIVATE THIS BG TAD I BASE TAD (INACTIVE-EMULATE /CLEAR EMULATE, SET INACTIVE IFZERO BGMAX-1 < DCA I BASE JMP I EMINACT > IFZERO BGMAX-2&4000 < AND (-LONG-1 /WE'RE NOT CPU-BOUND NOW 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 DCA EMBSINT /RESTORE RETURN ADDRESS JMS I (SETBASE JMP I EMBSINT /RETURN WITH BA .+1 /DISPATCH TABLE FOR /6040 EMSKIP /6041R /6043 DO6044 /604446 /6046 EMERROR /6047 DO6030 /6030 DO6031 /6031 DO6032 /6032 EMERROR /6033 DO6034 /6034 EMERROR /6035 DO6036 /6036 EMERROR /6037
/CONSOLE EMULATOR , EMULATES ALL 603X AND 604X IOT'S USERS INSTRUCTION ANDTAD KHTJMP /AND USE AS I DCA .+1 HLT /BRANCUTINES 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 JMS DEFER /FETCH HIS BACKLINK 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 DCA EMRUN /RESTORE RETURNADDRESS JMS I (SETBASE JMP I EMRUN EMQUIT, AC4000 /SET ECHO DISABLE EMECHO, JMS I (PUT /OR ENABLE UECHO JMP EMREDY /THAT'S ALL PAGE
DO6036, JMS I (GETQ /FETCH CHAR FROM BUFFER UBUFIN AND (377 DO6032, DCA I EMUAC /STORE IN/CLEAR UAC DO6030, JMS I (GETQ UBUFIN TAD (-375 SNA /ALTMODE ? TAD ("$-375 /MAKE IT A $ TAD (375 JMS I (PUT UCHAR JMS I (MTQ /BUMP INPUT BUFFER UBUFIN NOP /EMPTY JMP I (EMFRED /CLA;JMP EMREDY DO6044, DO6046, JMS I (GET UCHAR SPA S NOT YET BEEN ECHOED. ARE THIS CHAR AND LAST IRIP EXCESS BITS IN UAC CHO ? 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 I EMUAC /YES, MUST IGNORE SPACES ECHOED... TAD (-240 AND C177 /CLEAR EXCESNA CLA /SPACE ? JMPCHO ! DON'T CLEAR UCHAR UAC /NO, PUT IN OUTP UBUFOUT /ONE WORD TO OUTPUT BUFFER SNA CLA /CHAR ACCEPTED ? JMP KHEXT JMS I (EMINACT /DEACTIVATE BG D6046B, JMS MONITOR / STALL DGNTICK%5 JMS I (SETBASE /RESTORE BASE JMS I (QCOUNT /GET COUNTER OF OUTPUT BUFFER UBUFOUT TAD M10 /NEARLY EMPTY ? SMA CLA JMP D6046B JMS I (EMACTIV /ACTIVATE BG JMP D6046A /BACK TO USER PROGRAM KHEXT, JMS I (EMRUN /RUN OUTPUT WRITER UWRTR KHEXT2, TAD I X /IF THE CHAR WAS CR TAD M215 / SNA CLA /WE KNOW THAT A LF WAS ECHOED TOO TAD C212 JMS I (PUT /CLEAR UCHAR UCHAR JMP I (EMREDY
/6031 TEST WHETHER THERE IS A NEW CHARACTER AVAILABLE DO6031, JMS I (QCOUNT UBUFIN SZA CLA /EMPTY ? JMP I (EMSKIP /NO, LET BG SKIP /IF THERE IS NOTHING IN THE BUFFER,AND NEXT INSTR /IS 'JMP .-1' THEN TURN BG INACTIVE;ELSE GO TO /EMREDY. ACM1 TAD I EMUPC AND C177 TAD (5000 CIA DCA ZTEM1 JMS I (EMFETCH AND (7577 TAD ZTEM1 SZA CLA / JMP I (EMREDY /NOT WAITING JMR RUN BIT ... ISZ I X ADER JMS I (EMINACT /DOR /STOP UNTIL KICKED BYN EMSTRT, JMS I (SETBASE JMS I (EMACTIV /ACTIVATE BG JMP I (EMREDY DO6034, JMS I (GETQ /LOOK INTO BUFFER UBUFIN AND (377 EMOR, DCA ZTEM1 TAD ZTEM1 CMA AND I EMUAC TAD ZTEM1 DCA I EMUAC JMPS I (SETBASE /NOT ALWAYST BGERR TAD I BASE D1 < JMP I (EMREDY /GO TAD (EMREDY JMP I (EMBSI1 /LET BS KNOW WE'RE OUT > PAGE
/ROTATING BUFFER OPERATORS. CROSS-FIELD CALLABLE. /FIVE SUBROUTINES HAVE BEEN PUT TOGETHER IN ORDER TO /SAVE SPACE. FILLQ PUTS AN ELEMENT INTO THE BUFFER, /GETQ SHOWS THE FIRST ELEMENT IN THE Q, /QCOUNT GIVES THE NUMBER OF CHARACTERS IN THE Q, /CLEARQ CLEARS THE ENTIRE BUFFER /AND MTQ TAKES ONE FROM THE BUFFER. EACH BUFFER HAS ITS /OWN ADMINISTRATION, WHICH MAKES THE ROUTINES USEFUL FOR /MULTIPLE BUFFERS WITH EACH ITS OWN LENGTH AND CONTENTS. /THE ARGUMENT IS THE OFFSET OF THE POINTER TO THE BUFFER /RELATIVE TO 'BASE' IN THE CALLERS FIELD /THIS IS WHAT THE BUFFER LOOKS LIKE: /BUF, 16 /MAX. SIZE OF BUF. HERE THE BUF IS 16 LONG / 0 /COUNTER OF ELEMENTS IN THE BUFFER / 0 /'READ' POINTER,USED BY MTQ / 0 /'WRITE' POINTER, USED BY FILLQ / ZBLOCK 16 /THE ACTUAL BUFFER AREA /NOTE THAT THE BUFFER SHOULD BE SET UP AS ABOVE. / TAD ELEMENT / JMS I (FILLQ / UBUFIN OR UBUFOUT / BUFFER FUL IS ACCEPTED / NORMAL RITOR /SIZE OF BUF SAVED IN ADMINISTRATION OF BU AC IS SAVED FILLQ, .-. DCA QAC TAD FILLQ JMS SETFIL /INITIAL SETUP,COMMON FOR ALL. TAD I QPTR /BUFFER FULL? CMA TAD QSIZE /SIZE-COUNT-1 SPA JMP FILLQR-2 /BUF FULL;AC NOT ACCEPTED SZA CLA /LAST CHARACHTER TAKES ERROR RETURN ISZ FILLQ /BUF OK;NORMAL RETURN ISZ I QPTR /COUNT+1 ISZ QPTR JMS QWRAP /INCREMENT POINTER AND/OR WRAP TAD QAC /DEPOSIT DCA I QPTR JMP FILLQR CLA TAD QAC /RETURN NOT ACCEPTED CHAR FILLQR, CDF CIF /BACK TO CALLERS FIELD JMP I FILLQ
SETFIL, .-. //COMMON SETUP DCA FILLQ TAD I ZMYCDIF //GET CDF CIF TO CALLERS FIELD DCA FILLQR //PREPARE RETURN TAD I FILLQ //GET RELATIVE ADDRESS OF ARGUMENT TAD I (BASE //MAKE ABSOLUTE ADDRESS CDF MONFLD /THERE THE POINTERS ARE IFDEF BUFFLD < JMS DEFER /USE AS POINTER CDF BUFFLD /THERE THE BUFFERS ARE > IFNDEF BUFFLD < /TO AVOID "ID" ERRORS DCA X /AND THIS IS FASTER TOO TAD I X / > DCA QPTR TAD I QPTR /SAVE SIZE DCA QSIZE ISZ QPTR /POINTS TO S TO ERROR RETURN JMP NTER, AND TEST FOR END OOUND. RETURN WITH QPTR P /BUFFER LOCATION QWRAP, .-. ISZ QPTR /ALSO COMMON INSTRUCTION ISZ I QPTR /TRY NEXT LOC. IN BUF TAD QSIZE /BEYOND SIZE? CIA TAD I QPTR SMA CLA DCA I QPTR /WRAPS AROUND QWR1, TAD I QPTR /COMPUTE ABSO IAC DCA QPTR JMP IR / JMS CLRQ / UBUFRETURN CLRQ, 0 TAD SETFIL /COMMON SETUP DCA I QPTR /CLEAR COUNTER ISZ QPTR DCA I QPTR /CLEAR READ-POINTER ISZ QPTR DCA I QPTR /CLEAR WRITE-POINTER JMP FILLQR /RETURN
/FETCH THE NEXT ITEM FROM THE ROTATING BUFFER / JMS I (MTQ / UBUFIN OR UBUFOUT / EMPTY RETURN /AC=0 / NORMAL RETURN /AC=ELEMENT MTQ, .-. CLA TAD MTQ JMS SETFIL /DO COMMON SETUP TAD I QPTR /COUNT=0? SNA JMP FILLQR /Y, BUF EMPTY ISZ FILLQ /FOR NORMAL RETURN TAD M1 /SUBSTRACT ONE DCA I QPTR /N,CONFIRM JMS QWRAP /INC POINTER ETC. ISZ QPTR /READ POINTER COMES EARLIER. TAD I QPTR /FETCH JMP FILLQR /FETCH THE CURRENT CHARACTER WITHOUT MOVING POINTERS / / JMS GETQ / UBUFIN OR UBUFOUT /OFFSET ADDR IN BGDATA / RETURN /AC=CHARACTER GETQ, 0 TAD GETQ /FETCH RETURN ADDRESS JMS SETFIL /INITIALISE TAD I QPTR /GET COUNTER SNA CLA /EMPTY ? JMP FILLQR /YES, RETURN NULL ISZ QPTR /BUMP TO READPOINTER TAD QSIZE CIA IAC TAD I QPTR SPA /WRAP AROUND ? TAD QSITHIS IS ABS ADDRESS OF CLLQR /RETURN QCOUNT, ER VALUE OF Q TAD QCOUQPTR JMP FILLQR
/************************************************************ /************* O U T P U T W R I T E R **************** /************************************************************ /KHO TRANSPORT CHARACTERS FROBUFFER TO THE TERMINAL.TY, IT STOPS AND MUST BETBASE JMS MTQ /GET ONE CHAR UBUFOUT /OUTPUT BUFFER JMP KHLT /THERE IS NO MORE AND (377 /CLEAR RUBBISH;LOW PRIORITY:POS JMS I (PUT KHOTMP KHO1, IFZERO BGMAX-2&4000 < JMS I (GET /GET NAME OF OUTPUT DRIVER UTTY DCA KHCLL > JMS I (GET KHOTMP JMS MONITOR /AND PUT IT OUT CALL KHCLL, T1TCBP /NAME OF OUTPUT TASK JMP KHO2 /OUTPUT TASK BUSY:LOOP JMP KHO KHLT, JMS MONITOR /HALT THE OUTPUT WRITER EXIT KHO2, JMS MONITOR STALL DGNTICK%12 JMS I (SETBASE JMP KHO1 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.ND THUS ESTABLISH ^B-MODCUMULATE ONE INPUT BUFFEDITING (RUBOUT). WHEN THA 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. KHIST, KHI11, JMS I (SETBASE /NECESSARY IN CASE OF TIMEOUTFIN SNA CLA /ANY INPU /NO KHIRUN, JMS I (EMR UCUR KHI, JMS I (EMAD I BASE AND (BGERR+SWPERR SZA CLA /ERROR IN EMULATION OR SWP ? JMP I (KHI8 /Y, GET INTO ^B-MODE JMS I (GET / UKB DCA KHINAM JMS I (GET UREAD /GET READER RUN FLAG (=TIMEOUT JMS MONITOR /VALUE) CALL KHINAM, 0 JMP I (KHI3 /INPUT HANDLER BUSY:LOOP AND TRY SPA SNA /IGNORE NULL'S JMP KHI11 /TIMEOUT, ACTIVATE BG DCA ZTEM1 /SAVE TEMP JMS I (SETBASE /FOR WHICH BG?MAY HAVE CHANGED! TAD ZTEM1 / TAD (-217 /TEST FOR ^O SZA TAD (217-203 /TEST FOR ^C SNA JMS I (KHI4 /CLEAR INPUT AND OUTPUT BUFFERS TAD C2 /TEST FOR ^A / IAC /TEST FOR ^B SNA JMP KHI2 /CONTROL-B
/TO CONTROL THE SUPERFAST VIDEO DISPLAYS THE CHARACTERS /XOFF AND XON WILL STOP-START TERMINAL OUTPUT. THESE /CHARACTERS (^S AND ^Q) ARE NOT TRANSMITTED TO THE BG. TAD (201-223 / TAD (202-223 SNA /^S ? JMP I (KHISTP TAD C2 SNA CLA /^Q ? JMP I (KHICON JMS I (KHTEST /CONTROL GROUP OR PRINTING GROUP ? NOP /CONTROL-CHARS AND SUPPRESSED OW BG WE DIDN'T ECHO TO INPUT BUF JMS I (FILFFER UBUFIN SKP JMP KHILP /BUFFER FULL, KEEP LISTENING JMS KHIHLT /STOP TERMINAL READER /ECHO OR NOT - THAT'S THE QUESTION. KHI10, JMS I (KHTEST JMP KHI13 /CONTROL CHAR - DON'T ECHO JMP KHI12 /SUPPRESSED PRINTING CHAR TAD ZTEM1 TAD (-375 SZA CLA /ALTMODE ? PRINT $ TAD ZTEM1 /NO, PRINT THE CHAR JMS I (KHIOUT "$ TAD ZTEM1 TAD M215 SZA CLA /CR IS VERY DELICATE JMP KHI12 /NOT CR 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 KHI13, JMS KHIHLT /STOP THE TERMINAL READER JMP KHIRUN /AND ACTIVATE THE BG KHI12, JMS I (QCOUNT /SEE WHAT ROOM IS LEFT IN THE INPUT BUFFER UBUFIN TAD .+1 /THE NEXT INSTRUCTION HAPPENS TO BE -31 SPA SNA CLA /7 PLACES MORE ? JMP KHI /YES, DON'T PANIC JMP KHIRUN /NO, KICK THE BACKGROUND ACTIVE !
/CTRLB TYPED:GIVE HIM A QUICK ANSWER: "^B [CRLF] $" KHI2, JMS I (KHI4 /CLEAR THE BUFFERS, GIVE "^B" JMS I (KHIOUT "^ "B KHI21, JMS I (GESS BIT UECHO SPAAD C215 JMS I (KHIOUTUT JMS I (KHIOUT "$ TAD I BASE AND (-BGSTOP-BGERR-SWPERR-1 TAD (BGSTOP /SET BGSTOP: WE ARE IN ^B-MODE DCA I BASE JMS KHIHLT /CLEAR READER RUN FLAG JMP KHI /START OUTPUT WRITER AND LOOK FOR COMMANDET /GET READER FLAG WORD DCA I X /CLEAR READER PAGE
/THIS ROUTINE R IS /IN THE CONTROL-GROUP OR IN THE PRINTING GROUP. /PRINTING GROUP ARE 211,215 AND 240 - 375. KHTEST, 0 /SKIP IF 'PRINTING' CHAR. TAD ZTEM1 TAD (-240 SPA JMP KHT1 TAD (240-376 SPA CLA JMP KHT2 /PRINTING CHAR (240-375) JMP I KHTEST KHT1, TAD (240-211 SZA TAD M4 /(211-215 SZA CLA JMP I KHTEST KHT2, ISZ KHTEST JMS I (GET /ECHO SUPPRESSED ? UECHO SMA CLA ISZ KHTEST /NO, TAKE THIRD RETURN JMP I KHTEST KHI3, JMS MONITOR STALL DGNTICK%5 JMS I (SETBASE JMS I (GET UTTY DCA I (KHINAM JMP I (KHINAM-2 /INPUT IN ^B-MODE KHI5, TAD BASE JMS MONITOR /CALL THE CTRLB TASK CALL "C^100+"B&3777 JMP .-3 /BUSY ? DCA ZTEM1 JMS I (SETBASE TAD ZTEM1 /LOOK WHAT W'VE GOT SMA SZA JMP I (KHI21 /STAY IN ^B-MODE SNA CLA JMP KHI51 /GO BACK TO NORMAL PROCESSING JMS KHIOUT /ERROR "? JMP I (KHI21 /TRY AGAIN
KHI51, TAD I BASE IFZERO BGMAX-1 < AND (-BGSTOP-1 > IFNZRO BGMAX-1 < AND (-BASE /CLEAR BGSTOP IFNZBSINT /TEL BS W'RE IN THKHIHLT ISZ I X /SET TMS I (GET /UNSTACK ECHO-SUPPRESS BIT UECHO CLL RAL DCA I X JMP I (KHIRUN /GO ! /CLEAR INPUT AND OUTPUT BUFFERS KHI4, 0 /CLEAR BOTH BUFFERS JMS I (CLRQ UBUFIN JMS I (CLRQ UBUFOUT JMP I INE TO PUT ONE CHAR IN OR IN AC ? TAD I KHIOUMS I (FILLQ UBUFOUT JMP I KHIOUT KHI8, JMS I (CLRQ UBUFIN TAD BASE JMS MONITOR CALL "B^100+"E&3777 JMP .-3 JMS MONITOR STALL DGNTICK JMS I (SETBASE JMP I (KHI21
KHISTP, JMS I (GET /STOP OUTPUT WRITER UWRTR DCA .+3 JMS MONITOR STOP 0 HLT /NAME ? NOT ? FOUND ? JMP KHIC1 KHICON, JMS I (GET /RESTART OUTPUT WRITER UWRTR DCA .+3 JMS MONITOR RESTRT 0 HLT /NAME ? NOT ? FOUND ? KHIC1, JMS I (SETBASE JMP I (KHILP /ASK FOR MORE INPUT EMSPY, JMS I (EMFETCH /GET PARAMETER = FIELD AND C70 TAD C6201 DCA .+2 TAD I EMUAC HLT //CDF TO FIELD USER WANTS TO SEE JMS DEFER CDF MONFLD DCA I EMUAC JMP I (EMSKIP /SKIP PARAMETER PAGE
EMHAND, TAD I EMUAC CLL RTR /AC=XY, X=EMULATOR #, Y=UNIT # RAR AND C7 /GET EMULATOR INDEX TAD (HNDTAB DCA ZTEM1 /WILL LATER BE USED AT EM3 TAD BASE TAD (UDTV-1 /POINTER TO UDTV DCA AUTO10 AC0001 JMS I (EMFETCH /GET FUNCTION WORD DCA X TAFLDS^10 SMA SZA CLA S TO USE NON-EXISTENT MED DCA I AUTO10 /STORE (EMFETCH /GET BUFFER ADDRESS DCA I AUTO10 /STORE IN UDTV+1 TAD C3 JMS I (EMFETCH /GET BLOCK NUMBER DCA I AUTO10 /STORE IN UDTV+2 JMP I (EM3 /DISPATCH VIA HNDTAB HNDTAB, -EMSYS+EMDOT /EMULATOR FOR SYS: FOR DSK0:-DSK7: "T^100TA0:-DTA7: "L^100+"E&3 -EMERROR+EMDOT /RESERVERVED -EMERROR+EMDOT /RESERVED IFNDEF VC8E <-EMERROR+EMDOT / > IFDEF VC8E <"S^100+"H&3777 /SCOPE HANDLER >
EMSYS, JMS I (GET /SEE IF HE'S LOADING KBM OR CD. UDTV AND (6170 TAD (-BGFLD SZA CLA /READING TO FIELD 0 ? JMP EMSYS1 ISZ X TAD I X SZA CLA /CORE ADDRESS IS 0 ? JMP EMSYS1 ISZ X TAD I X TAD M7 SNA /READING KBM ? JMS I (EMREL /HE'S READING KBM: RELEASE HIS DEVICES TAD (-51+7 SNA CLA /READING CD ? JMS I (EMREL /HE'S READING CD: RELEASE HIS DEVICES EMSYS1, JMS I (GET UDISK /GET USERS VIRTUAL DISK NUMBER JMP EMDSK0 EMDSK, JMS I (GET UDTV /GET FUNCTION WORD: READ ONLY ! SPA CLA JMP EMDSK1 /THEY ARE TRYING TO FOOL US TAD I EMUAC /GET THE UNIT NUMBER EMDSK0, AND C7 DCA ZTEM1 JMS I (GET UDTV AND C7770 TAD ZTEM1 /JAM THE UNIT NUMBER IN DCA I X TAD X JMS MONITOR CALL "D^100+"K&3777 /THE TASK THAT IMPLEMENTS VIRTUAL DISKS JMP .-3 DCA .+3 JMS MONITOR WAIT 0ERROR CODE JMS I (SETBA EMDSK1, AC4000 JMS (EMREDY IFNZRO BGMAXX+1 /CLEAR THE BGBLOK-BIT OF ALL-1 BG'S DCA ZTEM1 TAD BASE EMBLK1, TAD (UNEXT JMS DEFER JMS DEFER AND (-BGBLOK-1 DCA I X TAD X ISZ ZTEM1 JMP EMBLK1 CLA TAD (EMREDY JMP I (EMBSI1 /KICK BG-SCHEDULER > PAGE /END OF BG EMULATOR >



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search