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 FROM
		/BEING SWAPPED IN AND WORK. THE TASK, WHICH
		/SETS THIS BIT WILL HAVE TO CLEAR IT PRETTY SOON

BGERR=4		/SET BY EMULATOR IN CASE OF ILLEGAL
		/INSTRUCTION. 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

EMUINST=ZTEM7
EMUAC=ZTEM4
EMUPC=ZTEM3
EMUFLD=ZTEM2	/KM8E

DELAY=DGNTICK^4%12	/SAMPLE FREQUENCY FOR KEYBOARDS
IFZERO DELAY <DELAY=1>

/IF AT DISP3, THE DISPATCHER THINKS 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 ///PREPARE FOR NORMAL INTERRUPT EXIT TAD I AUTO14 ///FETCH AC DCA INTAC /// IFDEF KM8E < TAD INTFLD DISP3A, RTF ///ALSO COME HERE AFTER FAST CLA ///CDF-EMULATION. 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 C7 ///EXTRACT DATAFIELD CLL RTL /// RAL /// TAD C6201 ///MAKE CDF DCA BGCDF /// TAD INTFLD /// AND C70 ///EXTRACT INSTRUCTION FIELD IFZERO MONFLD <TAD MYCIF///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 ///
/*********************************************************** /*********** C E N T R A L E M U L A T O R *********** /*********************************************************** TRAPINT,CINT ///CLEAR THE TRAP INTERRUPT FLAG 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, HLT ///CDF USERS INSTR. F. TAD I X ///GET HIS INSTRUCTION CLL RTR RTR TAD (-1310 ///IF IT IS A CDF 0 OR 1 AC=0 SZA CLA ///AND LINK IS COMPLEMENT OF F. JMP 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 /PREPARE POINTER TO FIELD WORD AC0001 TAD EMUFLD DCA EMUAC /PREPARE POINTER TO UAC AC0001 TAD EMUAC DCA EMUINST IFDEF KM8E < TAD MONITOR /WE STILL HAVE THE INSTRUCTION > 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 (EMREDY /BETWEEN CIF AND THE NEXT JMS/JMP. EMCDI, 0 /THIS IS A SUBROUTINE, BECAUSE WE TAD I EMUINST /WANT TO ALLOW CDF & CIF BETWEEN TAD (BGFLD /A CIF AND THE NEXT JMP 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, FIRST FORGET OLD DATAFIELD. AND C7770 /CLEAR BIT 9-11 OF UFLD. DCA X TAD ZTEM1 /GET NEW DATAFIELD SZL TAD C4 /SAVE LINK THROUGH ROTATE ! CLL RAR RTR TAD 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 TRUST A USER (NOP) SMA JMP EMIOT /6000-6777 (IOT) RTL /7000-7777 (OPR) SNL /WHICH GROUP ? JMP EMGRP1 /GROUP 1 AND (160 /GROUP 2 OR 3 SZA CLA /IS IT OSR, HLT 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 IT JMSJMP, RTR /INSTRUCTION AGAIN IN AC JMS I (EMADRES /COMPUTE EFFECTIVE ADDRESS. /EFFECTIVE ADDRESS IN ZTEM1 TAD I EMUFLD /NOW THAT WE FOUND THE JMS/JMP, 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 EMUINST /SIMPLE IOT EMULATOR FOR DISPLAYS ETC. DCA .+2 /PUT INSTRUCTION AHEAD TAD I EMUAC /LOAD USERS ACCUMULATOR HLT /USERS INSTRUCTION JMP .+3 /MAYBE IT'S A 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 WITH INSTRUCTION IN AC, DCA ZTEM1 /RETURN WITH ADDRESS IN ZTEM1, TAD I EMUINST AND C200 /0 OR 200 CIA /0 OR 7600 AND I EMUPC TAD ZTEM1 /NOW ADDRESS POINTED TO 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 RAL DCA ZTEM5 /WE ONLY NEED THE LINK NOW TAD I EMUAC MRIFLD, CDF BGFLD //NOT DANGEROUS FOR OPR.INSTR. MRINST, HLT //EMULATE ! JMP .+3 //DON'T SKIP CDF MONFLD /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 DCA .+1 HLT EM4TAB, EMERROR /6204 CINT IFDEF KM8E < EMRDF /6214 RDF EMRIF /6224 RIF > IFNDEF KM8E < EMERROR /6214 RDF EMERROR /6224 RIF > EMERROR /6234 RIB 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 /NON-EXECUTABLE IOT TAD EMLAST /EQUAL TO LAST NAME ? SNA CLA JMP EM10 /Y;DO NOT REPLACE NAME TAD I ZTEM1 /N;REPLACE NAME EM9, DCA EMNAME TAD EMNAME /REMEMBER ,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 BACKLINK OF BUSY TASK JMS DEFER /GET HIS BACKLINK CIA SZA /IS HE FREE NOW ? TAD CURTSK /COMPARE WITH CURTSK SZA CLA /OR IS HE FREE FOR ME ? JMP EMW1 /NO IFZERO 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 (GET USLOT DCA .+3 JMS MONITOR /WAIT TILL BG IN CORE WAIT 0 JMS I (SETBASE JMS I (GET UCOMM /GET TCBP OF TASK WE WERE AFTER JMP EM9 /GO BACK 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 BATCH ACTIVE IN THE BG ? CDF MONFLD RAL SPA CLA JMP I EMREL /YES, DON'T RELEASE > JMS I (PUT /ENABLE ECHO UECHO TAD (ASEMTB /WE PUT A POINTER TO THE LIST 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 MONITOR /RUN THESE TASKS WITH AC=0 RUN /THEY WILL MAKE AN 'EXIT' 0 NOP JMS I (SETBASE JMP EMLOOP PAGE
EMGIGA, TAD I EMUAC /UAC CONTAINS FUNCTION CODE 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 ZDISPATCH JMP EMBSI1 /TELL THE BS WE'RE READY > EMFETCH,0 /FETCH (PC+(AC)) FROM USER INSTR. FIELD TAD I EMUPC DCA ZTEM5 TAD I EMUFLD /GET USERS FIELD BITS AND C70 /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 BASE OK > KHTJMP, JMP I .+1 /DISPATCH TABLE FOR TERMINAL IOT'S EMREDY /6040 EMSKIP /6041 EMREDY /6042 EMERROR /6043 DO6044 /6044 EMERROR /6045 DO6046 /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 KH, TAD I EMUINST /FETCH USERS INSTRUCTION AND C17 /EXTRACT 4 BITS TAD KHTJMP /AND USE AS INDEX IN DISPATCH TABLE DCA .+1 HLT /BRANCH TO TERMINAL HANDLER ROUTINES 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 JMP D6046X /THIS CHAR HAS NOT YET BEEN ECHOED. CIA TAD I EMUAC /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 I EMUAC /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 I (GET UAC /NO, PUT IN OUTPUT BUFFER JMS I (FILLQ 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 JMS I (KHIHLT /CLEAR READER RUN BIT ... ISZ I X /AND SET IT TO START READER JMS I (EMINACT /DEACTIVATE BG JMS MONITOR /STOP UNTIL KICKED BY INPUT READER RETURN 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 JMP I (EMREDY EMERROR,JMS I (SETBASE /NOT ALWAYS NEEDED TAD (BGERR /SET BGERR TAD I BASE DCA I BASE IFZERO BGMAX-1 < JMP I (EMREDY /GO AWAY > IFNZRO BGMAX-1 < 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 FULL RETURN/AC=0, LAST CHAR IS ACCEPTED / NORMAL RETURN /AC=0 QSIZE=MONITOR /SIZE OF BUF SAVED HERE QPTR=CLRQ /POINTER IN ADMINISTRATION OF BUFFER. QAC=MTQ /HER THE 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 COUNT ISZ FILLQ /POINTS TO ERROR RETURN JMP I SETFIL /INCREMENT POINTER, AND TEST FOR END OF BUFFER. /ELSE WRAP-AROUND. RETURN WITH QPTR POINTING TO THE ABSOLUTE /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 ABSOLUTE ADDRESS TAD QPTR IAC DCA QPTR JMP I QWRAP /CLEAR A BUFFER / JMS CLRQ / UBUFIN OR UBUFOUT / NORMAL RETURN CLRQ, 0 TAD CLRQ /PREPARE EXIT JMS 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 QSIZE TAD C2 TAD QPTR /THIS IS ABS ADDRESS OF CHAR JMS DEFER JMP FILLQR /RETURN QCOUNT, 0 /ROUTINE TO GET COUNTER VALUE OF Q TAD QCOUNT JMS SETFIL TAD I QPTR JMP FILLQR
/************************************************************ /************* 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' KHO, JMS I (SETBASE 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. /^B WILL SET 'BGSTOP' AND THUS ESTABLISH ^B-MODE IN /WHICH KHI WILL ACCUMULATE ONE INPUT BUFFER OF COMMAND, /GIVING EDITING (RUBOUT). 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. KHIST, KHI11, JMS I (SETBASE /NECESSARY IN CASE OF TIMEOUT JMS I (QCOUNT 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 (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 PRINTING: AC4000 /SHOW BG WE DIDN'T ECHO TAD ZTEM1 /ENTER CHAR INTO INPUT BUF JMS I (FILLQ /ONE WORD TO INPUT BUFFER UBUFIN SKP JMP KHI10 SZA CLA 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 "^ JMS I (KHIOUT "A / "B KHI21, JMS I (GET /STACK HIS ECHO-SUPPRESS BIT UECHO SPA CLL RAR DCA I X TAD C215 JMS I (KHIOUT TAD C212 JMS I (KHIOUT 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 COMMAND KHIHLT, 0 JMS I (GET /GET READER FLAG WORD UREAD AND (7776 DCA I X /CLEAR READER RUN BIT JMP I KHIHLT PAGE
/THIS ROUTINE DETERMINES WHETHER A CHAR 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 (-BGSTOP-LONG-1 > DCA I BASE /CLEAR BGSTOP IFNZRO BGMAX-1 < JMS I (EMBSINT /TEL BS W'RE IN THE GAME AGAIN > JMS I (KHIHLT ISZ I X /SET THE READER RUN FLAG ! JMS 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 KHI4 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 /FULL ? SORRY ! 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 TAD X AND C70 TAD (-BGFLDS^10 SMA SZA CLA JMP I (EMERROR /HE TRIES TO USE NON-EXISTENT MEMORY TAD X TAD (BGFLD DCA I AUTO10 /STORE IN UDTV AC0002 JMS I (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: -EMDSK+EMDOT /EMULATOR FOR DSK0:-DSK7: "T^100+"E&3777 /EMULATOR FOR DTA0:-DTA7: "L^100+"E&3777 /EMULATOR FOR LPT: -EMERROR+EMDOT /RESERVED -EMERROR+EMDOT /RESERVED -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 0
DCA ZTEM1 /POSSIBLE ERROR CODE JMS I (SETBASE TAD ZTEM1 SZA CLA EMDSK1, AC4000 JMS I (PUT UAC JMP I (EMREDY IFNZRO BGMAX-1 < EMBLOK, TAD (-BGMAX+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