File: M3.PA of Tape: Sources/Multi8/m8-monitor-3-10-80
(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 >