1
0
mirror of synced 2026-04-19 17:13:24 +00:00
Files
lisper.cpus-pdp8/tss8/system/ts8c.pal
brad 0e9bfd9d85
2010-04-02 12:36:00 +00:00

1294 lines
31 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
SAVJO3, TAD JOB /DO WE HAVE A JOB #?
AND C0037
SNA CLA
JMP SAVJO2 /NOT YET
CLA IAC /CORRECT THE CLOCK SINCE IT'S ALWAYS ONE BEHIND
TAD CLOCK /ADD IN ANY TIME [S]HE HASN'T BEEN CHARGED FOR YET
TAD JOBTIM /TO THE NUMBER OF TICKS [S]HE HAS ACCUMULATED
DCA JOBTIM /NOW IT'S OK TO PUT HIM/HER AWAY
CDF /GET POINTER TO LOW ORDER RUNTIME
GETJTW
JOBRTM
CLL
TAD JOBTIM /# TICKS [S]HE USED
DATFLD
DCA I JOBSWA /SAVE THE NEW CUMULATIVE TIME
ISZ JOBSWA
SZL /OVERFLOW INTO HIGH ORDER?
ISZ I JOBSWA /BUMP IT; WOULD NEED 16777216 TICKS FOR THIS TO SKIP!!
TAD SCHNEW /WAS THIS JOB TO HAVE A FULL SLICE?
TAD JOBTIM /ANY PART OF HIS/HER TIME SLICE STILL LEFT?
SPA SNA CLA
JMP SAVJO2 /YES, SO THIS JOB IS NOT A COMPUTE BOUND JOB AT THIS STAGE
TAD I CJOBDA
IAC /STR0
IOR /MAKE HIM/HER COMPUTE BOUND
JCOMBD
SAVJO2, DCA JOB /SIMULATE NULJOB
DATFLD
DCA I CJOBDA /CLEAR POINTER TO CURRENT JOB DATA AREA
CDF
JMP I SAVJO0 /AND EXIT
RUNULL, SCHNUL
DEBUG, /RESTART FOR DEBUGGING
IFZERO DC08A <
IFZERO CPU-1 < /SET PDP-8 CLOCK COUNT
STA
CCF CLB >
IFNZRO CPU-4 <CECI>
IFZERO CPU-4 <IAC
CLLE
CLA>>
IFNZRO DC08A < T1ON > /TURN ON DC08 CLOCK
IFZERO D689-4 < EDF > /REENABLE DATA PHONES
DCA SCHNEW /ENABLE SCHEDULER TO BUMP NULL JOB
JMP I RUNULL
*3200
/PROCESS KEYBOARD INPUT CHARACTERS (MAY BE PSEUDO-INPUT)
/MULTI-FIELD ROUTINE
/CALL: CHARACTER IN "TTCHAR"
/ JMS KBD
/ DEVTBL POINTER
/ RETURN; NO ROOM - CHARACTER NOT STORED
/ RETURN; CHARACTER STORED
/
KBDCNT=WS2
KBDSIB, -212 /DO NOT MOVE FROM BEGINNING OF A PAGE - SEE "DUPSI"
IFNZRO KBDSIB&177 <YOU GOOFED>
KBD00, 0
TAD I KBD00 /GET DEVTBL POINTER
DCA CONDBA
RDF
TAD C6203
DCA KBDNSX /REMEMBER FROM WHENCE WE CAME
ISZ KBD00
DATFLD
TAD I CONDBA /GET DDB ADDRESS
DCA CONDDB
KBDSQ, JMS I KBDCON /CHECK ^S/^Q; (ISZ CONDBA IF FEATURE DISABLED)
TAD I CONDDB /YES - GET DDB STATUS
AND C0100
SZA CLA /"SICOM" SET?
JMP KBDNSX /YES - EXIT
TAD TTCHAR /CHECK FOR ^B, ^C
TAD KBDMCB
CLL RAR
SZA CLA /IS IT ^B OR ^C?
JMP KBD05 /NOTHING SPECIAL ABOUT THIS ONE
TAD CONDDB
JMS I KBDCLB /CLEAR HIS/HER INPUT BUFFER
TAD TTCHAR
RAR
SNL CLA /WAS IT ^B OR ^C?
JMS I KBDCHK /WAS ^B TYPED IN USER MODE?
JMP KBD04 /CLEAR OUTPUT
TAD I CONDDB
TAD C1000 /PUT THIS TTY IN SI MODE
DCA I CONDDB
KBD02, TAD KBDUPA
DCA TTCHAR /CHANGE TO ^
CDF
PRINT /STASH "^" IN HIS/HER OUTPUT BUFFER
"B /WE DON'T CARE IF "PRINT" FAILS
TAD .-1
DCA TTCHAR /CHANGE TO B
KBD01, CLL STA RTR
RTR
DATFLD
AND I CONDDB /CLEAR "FULL" STATUS
DCA I CONDDB
KBD03, TAD I CONDDB /GET DDB STATUS BITS
AND DUPSI
ISZ CONDDB
SZA CLA /DUPLEX OR SI MODE?
TAD I CONDDB
SNA CLA /AND LOGGED IN?
JMP KBDXIT /NO - SO DON'T ECHO
CDF
PRINT /STASH (TTCHAR) IN HIS/HER OUTPUT BUFFER
KBDUPA, "^ /WE DON'T CARE IF "PRINT" FAILS
KBDXIT, ISZ KBD00 /SHOW SUCCESS
KBDNSX, .-. /BACK TO THE CALLING FIELD
JMP I KBD00
KBD04, TAD I CONDBA
JMS I KBDCLB /CLEAR THE OUTPUT BUFFER
TAD TTCHAR
RAR
SNL CLA /WAS IT ^B OR, OR ^C?
JMP KBD02 /IT WAS ^B
JMS I KBDCHK /USER MODE?
JMP KBDSSI /NO, GO TO SI FOR DOT OR ^B
JMP I KBDCCA /YES, GO DO ^C BUSINESS
KBD05, TAD C7770 /IS THERE PLENTY OF FREE CORE?
TAD FRECNT
SPA CLA
JMP KBDNSX /NO
JMS I KBDCHK /WHICH MODE?
JMS I KBDLRA /SI - CHECK FOR LINE-FEED AND RUBOUT
TAD I CONDDB
AND C0400 /"FULL" FLAG SET?
SZA CLA
JMP KBDNSX /YES - EXIT
TAD CONDDB
STORE /STASH (TTCHAR) IN HIS/HER INPUT BUFFER
KBD06 /FOR SIZE CHECK
JMP KBDNSX /STORE FAILED; BUFFER ALREADY FULL
JMS I KBDCHK /WHICH MODE?
JMP KBD08 /SI
STL RTL /AC=2
TAD CONDDB /POINT TO BREAK MASK
DCA KBDCNT
TAD I KBDCNT /GET THE BREAK MASK
JMS I BRKTSA /IS IT A BREAK CHARACTER?
JMS I KBDBRK /GO SET DEL BIT IN STR1 AND PUT HIS/HER JOB NUMBER IN BONUS
DATFLD
JMP KBD03 /SEE IF WE SHOULD ECHO
KBDBRK, KBDDLM
KBDCCA, GIR9
KBDLRA, KBDLRB
DUPSI,
KBD08, TAD KBDSIB /USED AS CONSTANT (MASK) SEE "KBD03+1"
TAD TTCHAR
AND KBDSIM
SZA CLA /IS THIS A BREAK FOR SI?
JMP KBD03 /NO
KBD11, ISZ COMCNT /TO SCHEDULE "SI"
TAD I CONDDB
TAD C0100 /SET "SICOM"
DCA I CONDDB /SAVE NEW KEYBOARD STATUS
JMP KBDXIT /EXIT WITHOUT ECHOING THE DELIMITING CHARACTER
KBDCON, CONSQ
BRKTSA, BRKTST
KBDMCB, -"B+100 /-^B
KBDCLB, CLRBUF
KBDCHK, KBDMOD
KBD09, TAD CONDDB
TAD C0005
DCA KBDCNT /POINTS TO CHARACTER COUNT IN DDB
TAD I KBDCNT
CIA
DCA KBDCNT /NUMBER OF CHARACTERS TO SPIN THROUGH THE BUFFER
DCA WS0 /FAKE HIS/HER BREAK MASK TO ZERO
KBD10, TAD CONDDB
FETCH /FETCH A CHARACTER
JMP KBDSSI /BUFFER EMPTY
DCA TTCHAR /SAVE IT
ISZ KBDCNT /RUB THIS ONE?
SKP
JMP KBD03 /YES - PRINT IT
TAD CONDDB
STORE /NO - PUT IT BACK
ALLOK /NO LIMIT
KB0040, DECHO /NOP /CAN'T FAIL
JMP KBD10
KBDSIM, /THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
KBDSSI, TAD KB0040 /SET "DECHO"; SCHEDULE SI TO PRINT CURRENT LINE
JMP KBD11 /PRECEDED BY EITHER "." OR "^B"
IFNZRO KB0040&177-174 <CHANGE KBDSIM>
*3400
/KEYBOARD IOTS
/SEE IF THE USER IS GOING TO EXECUTE A "JMP .-1" AFTER A NON-SKIPPING "KSF"
JMPTST, TAD UUOADD /ADDRESS OF THE "KSF"
AND C0177 /JUST THE PAGE ADDRESS BITS
TAD C5200 /MAKE UP THE REQUIRED "JMP" INSTRUCTION
CIA
UDF /SELECTS USER'S FIELD
TAD I L2SV0 /USER'S INSTRUCTION
DATFLD
SNA
JMP JMPTS1 /WE CAUGHT HIM/HER!
TAD C0200 /MAYBE IT'S A PAGE 0 "JMP"
SZA CLA
JMP JMPTS0 /NO - MUST BE SOMETHING ELSE - LET HIM/HER CONTINUE
TAD CC7600 /WILL WE BE ON PAGE 0?
AND UUOADD
SNA CLA
JMPTS1, TAD UKEYFL /PUT HIM/HER TO SLEEP - SO [S]HE DOESN'T WASTE OUR TIME
JMPTS0, DCA UKEYC /SAVE WAIT CCONDITION
STL RTR
AND I CONDDB
SNA CLA /NEED XON?
JMP JMPTS2 /NO
TAD UKXON
DCA TTCHAR
ISZ CONDBA /POINT TO OUTPUT SIDE
CDF
PRINT /SEND XON
WAIT /DIDN'T FIT - TRY AGAIN LATER
CLL STA RTR
DATFLD
AND I CONDDB /CLEAR XOFF BIT
DCA I CONDDB
JMPTS2, TAD UKEYC /WAIT FOR FLAG; EXCEPT KSF WITHOUT JMP .-1
UUOEXT
IFNZRO JMPTST&4177 <YOU GOOFED>
UKL2SA, L2SA
UKEY0A, UKT0
UKEY1A, UKT1
UKWAIT, STA /BACK UP HIS/HER PC
TAD L2SV0
DCA L2SV0
JMP JMPTS1 /SEE IF XON SHOULD BE SENT
UKXON, 221
UKEY, JMS I UKEY0A /MAKE SURE [S]HE'S NOT IN SI MODE
JMS I UKEY1A /WHAT DOES [S]HE WANT TO DO?
JMP UKEYRS /READ STRING
UKEYFL, JSDEL JSERR /DELIMITER FLAG OR ERROR FLAG
C5200, JMP JMPTST /MAKE SURE [S]HE'S NOT HANGING ON "JMP .-1"
RAR
SPA CLA
DCA L2SA /KCC - CLEAR AC
SNL CLA /IS KRB OR KRS REQUESTED?
UUOEXT /NO - ALL DONE
DATFLD
TAD CONDDB
FETCH /GET A CHARACTER FROM THE BUFFER
JMP UKWAIT /NONE AVAILABLE
DCA UKEYC /SAVE CHARACTER
TAD UKL2SA /OR INTO USER'S AC
CDF
IOR /IT WOULD PROBABLY BE ADEQUATE TO JAM IT INTO HIS/HER AC
UKEYC, 0
UUOEXT /AND BACK TO USER
UKREAD, 0
DCA WS0 /SAVE THE BREAK MASK
TAD L2SA /POINTS TO PARAMETERS IN USER AREA
IAC
DCA WS1 /ADDR OF USER BUFFER POINTER
UDF
TAD I WS1 /USER BUFFER ADDRESS
DCA AXS2
UKEYR1, DATFLD
TAD CONDDB
FETCH /GET A CHARACTER
JMP I UKREAD /THEY'RE FRESH OUT
UDF /SELECT USER FIELD
DCA TTCHAR
TAD TTCHAR
DCA I AXS2
ISZ I WS1 /UPDATE USER POINTER
MRUB, -377 /NOP
TAD WS0 /IS IT A DELIMITER?
ISZ I L2SA /DONE?
JMS BRKTST
CLA SKP /WE'RE FINISHED
JMP UKEYR1 /BACK FOR MORE
DCA L2SA /CLEAR AC
ISZ UKREAD /SKIP ON RETURN
JMP I UKREAD
/READ INPUT STRING
UKEYRS, DATFLD
STL RTL
TAD CONDDB /ADDRESS OF DDB
DCA WS0 /POINTS TO BREAK MASK
TAD I WS0 /GET BREAK MASK
JMS UKREAD /READ STRING
JMP UKWAIT /WAIT FOR HIM/HER TO TYPE SOME MORE
UUOEXT
BRKTST, 0
CDF
SPA SNA
JMP BRKTS2
DCA WS0 /SAVE THE BREAK MASK
TAD BRKTBA /ADDRESS OF BREAK TABLE
DCA AXS1
TAD TTCHAR /CHARACTER TO COMPARE WITH TABLE
BRKTS1, ISZ AXS1 /SKIP OVER MASK
TAD I AXS1 /-HIGH END OF RANGE
CLL
TAD I AXS1 /+NUMBER OF CHARACTERS IN THIS RANGE
SNL
JMP BRKTS1 /NOT IN THIS GROUP
CC7600, CLA 400 /WE FOUND IT
TAD I AXS1 /GET THE MASK
AND WS0 /COMPARE IT WITH OUR MASK
BRKTS2, SNA CLA /IS IT A BREAK CHARACTER?
ISZ BRKTST /NO
JMP I BRKTST
BRKTBA, BRKTBL-2
MLF, 377-212
KBD09A, KBD09
KBDLRB, 0
TAD MRUB
TAD TTCHAR
SNA
JMP I KBD09A /RUBOUT
TAD MLF
SZA CLA
JMP I KBDLRB /NORMAL CHARACTER
JMP I .+1 /LINE-FEED
KBDSSI
*3600
IFZERO CPU-2 < /TEMPORARY POWER FAIL HANDLER FOR 8/E
POWINT, CLA
DCA 0 /CLEAR LOCATION 0 SO WE'LL FALL THROUGH IT
TAD POW2 /CLOBBER LOCATION 2 (C0200) SO WE'LL COME TO "POWST"
/WHEN THE JUICE RETURNS
DCA 2
HLT /POWER FAILURE; WILL START AT POWST WHEN POWER COMES UP
POW2, POWST
POWST, DCA WS1
ISZ WS0 /WE DELAY ABOUT A MINUTE TO MAKE SURE
JMP .-1 /THE DISK IS UP TO SPEED
ISZ WS1
JMP .-3
JMP I .+1 /NOW GO CALL INIT
BOOT
USGT, SGT /SKIP ON PDP-8/E GREATER THAN FLAG (EAE)
UUOEXT
JMP I .+1 /CAUSE SKIP ON RETURN
UUOEX2
>
IFNZRO CPU&7776 <
UGTF, SGT /PDP-8/E "GET FLAGS" SIMULATOR
SKP
STL RTR /POSITION OF GT FLAG
TAD L2SVLK /AND GIVE HIM/HER THE LINK
DCA L2SA
UUOEXT
URTF, CLA STL IAC RTR /AC=6000
AND L2SA /SAVE ONLY LINK AND GT BITS OF HIS/HER AC
RTF /RESTORE AS REQUESTED
CLA RAR /FETCH NEW LINK
DCA L2SVLK /SAVE FOR THE USER
UUOEXT
>
IFNZRO DC08A <
DC08B= DC08A+4%5
T8FITH, -DC08B
T8TTIA, T8TTI
T8LC, -1
T8SF, 0
T8SV0, 0
T8SVLK, 0
T8SA, 0
T8FLG, 0
T8CNT0, -1 /SO IT WILL INITIALIZE ITSELF THE FIRST TIME IT'S USED
T8CNT1, 0
T8CNT2, 0
T8N5, -5
T8OBA, SKPTBL+PT08+KL8+2
T8OBF, 0
T8NLN, -DC08A
T8LINE, DC08LO-SKPTBL-PT08-KL8-2
RESTA, RESTOR
T8SFA, T8SF
T8BF2, OUTREG-SKPTBL-1
T8TMP, 0
T83000, 3000
TTOFLD, TTOFLG
T8RTN, DISMI2
T8DIS, T1ON /RE-ENABLE THE CLOCK
ISZ T8LC
JMP I T8RTN /ALREADY SERVICING DC08
DCA T8SA /SAVE AC
RAR
DCA T8SVLK /AND LINK
TAD 0
DCA T8SV0 /AND PC
RIB
DCA T8SF /FIELD & MODE
DCA T8FLG /CLEAR DC08A LEVEL 2 SERVICE FLAG
T8IN, TAD T8FITH
TTCR TTLR /LIMIT INPUT TO 1/5 OF THE LINES
DCA T8CNT2 /SAVE ALSO AS THE OUTPUT LINE COUNT
ION
CIF DATFLD
JMP I T8TTIA /TAKE A PASS THROUGH THE TTI STRING
/RETURNS HERE AFTER SERVICING INPUT SIDE (TTI'S)
T8OUT1, ISZ T8CNT0 /BUMP DIVIDE BY 5 COUNTER
JMP T8OUT2 /CONTINUE CURRENT PASS
TAD T8N5
DCA T8CNT0 /RESET MAJOR COUNTER
TAD T8OBA
DCA T8OBF /RESET OUTPUT BUFFER POINTER
TAD T8NLN
DCA T8CNT1 /RESET TOTAL NUMBER OF LINES COUNTER
T8OUT2, TAD T8CNT1
SMA CLA /ANYTHING LEFT THIS PASS?
JMP T8EXT /NO
TAD T8LINE /LINE NUMBER TO START AT
TAD T8OBF /COMPUTED FROM CURRENT BUFFER POSITION
TTCL TTLL /LOAD IT INTO THE DC08A
CLA
T8OUT3, TAD I T8OBF /BITS TO BE OUTPUT
SZA
JMP T8OUT5 /MUST BE SOMETHING THERE
TTIL /NOTHING - JUST BUMP THE LINE NUMBER
T8OUT4, ISZ TIOBF /BUMP THE BUFFER POINTER
ISZ T8CNT1 /AND THE TOTAL LINE COUNT
SKP
JMP T8EXT /FINISHED
ISZ T8CNT2 /CURRENT PASS COCUNT
JMP T8OUT3 /ONTO THE NEXT LINE
T8EXT, IOF
STL STA /DECREMENT THE INTERRUPT COUNT
TAD T8LC
DCA T8LC
SNL /ALL ACCOUNTED FOR?
JMP T8IN /NO - MAKE ANOTHER ROUND
TAD T8FLG /DOES THE DC08 REQUIRE LEVEL 2
TAD L2Q /OR SOMETHING ELSE?
CIA
TAD L2QE
AND T8SF /ALLOW "L2EXIT" ONLY IF FROM USER MODE
AND C0100
SZA CLA /HOW SHOULD WE EXIT?
JMP T8EXIT /VIA L2EXIT
TAD T8SFA /BACK TO WHERE WE CAME FROM
CDF
JMP I RESTA
/MOVE THE ACTIVE REGISTERS OVER TO LEVEL 2
T8EXIT, TAD T8SVLK /THE LINK
DCA L2SVLK
TAD T8SA /THE AC
DCA L2SA
TAD T8SV0 /THE PC
DCA L2SV0
TAD T8SF /FIELDS & MODE
DCA L2SF
EXIT
T8OUT5, TTO TTIL /OUTPUT A BIT
SZA
JMP T8OUT8 /SAVE THE REMAINING BITS FOR NEXT TIME
T8OUT6, TAD T8OBF /OUR POSITION
TAD T8BF2 /MINUS THE OFFSET
DCA T8TMP /SECOND BUFFER
TAD I T8TMP
RAR
SNL /ANYTHING WAITING?
JMP T8OUT7 /NO
AND C0377
CLL RAL
TAD T83000 /NOW THE STOP BITS & START BIT ARE IN PLACE
DCA I T8OBF /SAVE IT TO BE OUTPUT NEXT TIME
STL IAC RTR
DCA I T8TMP /SET BOTH HARDWARE BUSY AND SERVICE FLAGS
CDF
DCA I TTOFLD /SET "CONOUT" FLAG
DATFLD
ISZ T8FLG /SCHEDULE LEVEL 2 FOR US
JMP T8OUT4
T8OUT7, STL CLA RAR
AND I T8TMP
DCA I T8TMP /CLEAR EVERYTHING EXCEPT SERVICE FLAG
T8OUT8, DCA I T8OBF
JMP T8OUT4
T8IN1, 0
IOF
DCA I ACX11 /STASH IT IN THE RING BUFFER
TTRL
TAD T8BASE /MAKE DC08A LINE NUMBER = KXX
JMS I T8INPA /FINISH HOUSE-CLEANING
ISZ T8FLG /SCHEDULE LEVEL 2
CIF DATFLD
JMP I T8IN1 /BACK TO FIELD 1
T8BASE, PT08+KL8-DC08LO+1
T8INPA, ACINT9
>/END OF FIELD 0 DC08A CODE
*4000
/ THIS WILL RUN A "ROUND ROBIN" OF CORE RESIDENT JOBS
NXTCO1, DCA SCHNEW /ANY JOB STARTED FROM HERE MAY BE THROWN OFF
NXTCOR, ISZ NXTCNT /HAVE WE CHECK ALL ENTRIES?
TAD NXTCNT
SMA SZA CLA
JMP I NXTNUL /YES; NOTHING RUNNABLE EXCEPT NULL JOB
NXTCO2, ISZ NXTCOP /BUMP CORTBL POINTER
TAD NXTCOP /ARE WE PAST THE END OF THE TABLE?
TAD I NXTEND
SZA CLA /?
JMP .+3 /NOT YET
TAD FANCOR /YES, START AT THE BEGINNING AGAIN
DCA NXTCOP /ALL SET
TAD I NXTCOP /GET CORTBL ENTRY
SNA /IS THERE ANYTHING IN THERE?
JMP NXTCO4 /NO; CLEAR DEAD JOB POINTER (A FREE FIELD IS BETTER)
AND C6600 /IS IT BEING SWAPPED, LOCKED, OR A PHANTOM?
SZA CLA
JMP NXTCOR /YES - SO IT'S NOT A USEFULL FIELD NOW
TAD I NXTCOP
AND C0037
RUNABL
JMP NXTCO3 /NOT RUNNABLE
TAD I NXTCOP /TRY TO RUN THIS ONE
AND C0037 /GET JOBTBL INDEX
TAD JOBTBA /GET POINTER TO JOB DATA
GETJTI /GET VALUE OF STR0
JOBSTS
AND C0107 /DOES [S]HE WANT TO RUN FIP OR SI FOR ERROR?
SZA CLA
JMP NXTCOR /HAVE TO WAIT 'TIL LATER
TAD I NXTCOP
JMP I .+1 /GO RUN THIS ONE
SCHEI2
NXTCO3, STA
TAD NXTCOP /POINTER-1 OF DEAD JOB
DCA DEAD /SAVE IT
TAD NXTCOP
TAD NXTFLD /FIELD INDEX ONLY
JMS I NXTDSK /IS THERE DISK ACTIVITY IN THIS FIELD?
NXTCO4, DCA DEAD /YES; SO [S]HE'S NOT REALLY DEAD-WOOD THEN
JMP NXTCOR /KEEPLOOKING
NXTNUL, SCHNUL
NXTFLD= C1000 /-CORTBL+1
NXTDSK, DSKACT
NXTCOP, CORTBL+1 /ROUND ROBIN CORTBL POINTER
NXTEND, CORTBE /END OR CORTBL
C0107, 107
C6600, SWAP+LOCK+FIP+SI
UHALSA, L2SA
UHALT, TAD UUOCAL /IS IT AN OSR?
AND C0004
SNA CLA /OSR?
JMP UHALT1 /NO
CDF
GETJTW /YES, GET CURRENT VALUE OF SWITCHES
JOBSWR
DCA UHALT2 /OR IT INTO AC
TAD UHALSA /WHICH IS RIDICULOUS, SINCE OSR
IOR /IS UNIVERSALLY CODED AS LAS, AND
NXTCNT,
UHALT2, 0 /A SIMPLE "DCA L2SA" WOULD DO
UHALT1, TAD UUOCAL /NOW SEE IF IT WAS MICROCODED
AND C0002 /HALT?
SNA CLA
UUOEXT
JMS I USBCSI /LOCATE HIS/HER DDB AND SEE IF [S]HE'S IN SI MODE
TAD FRECNT /USER HAS EXECUTED HLT
TAD C7770
SPA SNA CLA /IF WE'RE SHORT ON FREE CORE, TRY LATER
REDO
GETJTW /CLEAR HIS/HER RUN BIT
JOBSTS
AND C3777 /CLEAR JSRUN
DATFLD
DCA I JOBSWA
TAD CONDBA /CONDBA WAS SET UP BY THE JMS TO UKT0
JMS UHLTMS /NOW TYPE ^BS FOR HIM/HER
WAIT
UHLTMS, 0
DCA UHLTM1 /SET DEVTBL POINTER
RDF
TAD UHMES /EITHER TYPE ^BS OR ^BS;K
DCA AXS2
CDF
UHLTM0, TAD I AXS2 /GET A CHARACTER
SPA SNA
JMP UHLTM2 /END OF TEXT
DCA TTCHAR /SAVE IT
KEY /RUN IT INTO HIS/HER INPUT BUFFER
UHLTM1, .-.
NOP
JMP UHLTM0 /GET ANOTHER ONE
UHLTM2, SZA CLA /WHERE DID WE COME FROM?
CIF DATFLD /BACK TO 689 SERVICE
JMP I UHLTMS
UHMES, .
"B-100
"S
";
"K
215
C7377, 7377
USBCLR, CLRBUF
USBFLG, CLSTR1
"B-100
"S
213
0
USBCSI, UKT0
/SELECTIVE BUFFER CLEAR
USBC, JMS I USBCSI /CHECK FOR SI MODE
DATFLD
TAD L2SA
CLL RAL
SMA CLA /CLEAR INPUT BUFFER?
JMP USBC3 /NO
TAD CONDDB /INPUT DDB ADDRESS
JMS I USBCLR /CLEAR INPUT BUFFER
TAD C0100
JMS I USBFLG /CLEAR FLAG
TAD I CONDDB
AND C7377 /CLEAR FULL BIT
DCA I CONDDB
USBC3, TAD L2SA /WHAT IS REQUESTED?
SMA CLA /CLEAR OUTPUT BUFFER?
JMP USBC4 /NO
ISZ CONDBA /POINT TO OUTPUT SIDE
TAD I CONDBA
JMS I USBCLR /CLEAR OUTPUT BUFFER
USBC4, DCA L2SA /CLEAR HIS/HER AC
UUOEXT
*4200
/STANDARD BOOTSTRAP AND RESTART ADDRESSES
JMP I .+2 /INIT BOOTSTRAP
JMP I .+2 /RESTART ADDRESS
BOOT
DEBUG
FILERC, 0 /ROUTINE TO RECOVER FROM DISK ERRORS
FILUSA, 0 /AND SET ERROR CODES FOR USER
FILEWC, 0 /ERROR CODES ARE:
FILER1= WS2 / 1 PARITY
/ 2 END OF FILE
/ 3 FILE NOT OPEN
/ 4 PROTECTION VIOLATION
FJSF3, -JSF3-1
FILECA= C0004 /FILPCA
FILECT= C0007 /FILPCT
FILEIF= C0002 /FILPIF
C6000, 6000
FILERR, 0
DCA FILERC /ERROR CODE
CLL CLA CMA RAL /AC:=-2
TAD FILERC /ERROR CODE - .GT.2?
SPA SNA CLA /PROTECTED OR NOT OPEN?
JMP FILER2 /NO
GETJTW /GET ADDRESS OF PARAMETER BLOCK
JOBLNK
RETBLK /RETURN IT TO FREE CORE
CLA
TAD L2SA /GET POINTER TO PARAMETERS IN USER AREA
TAD F0005
DCA FILERR /POINTS TO SIXTH USER PARAMETER (ERROR CODE)
TAD FILERC /GET ERROR
UDF /SELECT USER FIELD
DCA I FILERR /PASS ERROR TO USER
CDF
DCA L2SA /CLEAR HIS/HER AC
UUOEXT /AND BACK TO HIM/HER
FILER2, TAD I FILERR /END OF FILE OR PARITY ERROR...
TAD FILEIF /GET ADDRESS OF FILE PARAMETER BLOCK
DCA FILER5 /POINTS TO WORD 3 OF BLOCK
DATFLD
TAD I FILER5 /WAS FILE CALL ORIGINATED BY SI?
AND C6000 /BITS 0-1 WILL BE SET IF SO...
SNA CLA
JMP FILER4 /NO - IT CAME FROM USER PROGRAM
TAD I FILER5 /YES - GET FIELD # FOR TRANSFER
RTR
AND C0007 /MASK OUT FILE # BITS
TAD CORTBA /INDEX INTO CORTBL
DCA FILUSA /SAVE POINTER TO CORTBL ENTRY FOR THIS TRANSFER
CDF
TAD I FILUSA /GET CORTBL ENTRY
AND C0037 /EXTRACT JOB #
DCA FILUSA /SAVE JOB #
CLL CMA RAL /AC=-2
TAD FILERC /IS IT AN END OF FILE?
SNA CLA
JMP FILER3 /YES; WE'RE ALMOST DONE THEN
TAD FILERC /NO - WAS THERE ANY ERROR AT ALL?
SNA CLA
JMP FILER3 /NO
TAD FILUSA /PARITY ERROR - SET SYSTEM ERROR CODE IN STR0
ERROR
F0005, DSKERR
FILER3, ISZ FILERR /INDEX PAST CALLING ARGUMENT
CDF
JMP I FILERR /AND BACK
FILER4, TAD I FILER5 /UPDATE USER CONTROL TO INDICATE ERROR CODE
RAL /SHIFT FIELD # INTO BITS 6-8
AND C0070 /SAVE IT
TAD FILCDF /GENERATE "UDF"
DCA FILER5 /USER FIELD SELECT
CDF
TAD I FILERR /PARAMETER BLOCK ADDRESS
DCA FILEWC /SAVE IT
TAD FILEWC
DATFLD
TAD FILECA
DCA FILER1 /POINTS TO CORE ADDRESS IN PARAMETER BLOCK
TAD I FILER1 /GET CORE ADDRESS
DCA FILER1 /SAVE IT
TAD FILEWC /START OF PARAMETERS
TAD FILECT /+7
DCA FILUSA /POINTS TO PTR TO FILE CONTROL
TAD I FILUSA /GET ADDRESS OF FILE CONTROL
TAD C0006 /POINTS TO WORD COUNT IN FILE CONTROL
DCA FILEWC /SAVE IT
TAD FILEWC
IAC
DCA FILUSA /POINTS TO POINTER TO USER PARAMETERS
TAD I FILUSA /GET POINTER TO USER ARGUMENTS
DCA FILUSA /SAVE
TAD I FILEWC /GET WORD COUNT TO GO FROM CONTROL BLOCK
FILER5, 0 /SELECT USER FIELD
DCA I FILUSA /SAVE IN USER AREA
ISZ FILUSA /POINTS TO WORD 4 OF USER ARGUMENTS
TAD FILER1 /GET LATEST CORE XFER ADDRESS
DCA I FILUSA /SAVE FOR USER
ISZ FILUSA
ISZ FILUSA /POINTS TO WORD 6 (ERROR WORD)
TAD FILERC /GET ERROR CODE
DCA I FILUSA /PASS ON TO USER
FILCDF, CDF
JMP FILER3 /AND BACK
BRKTBL, -"Z-1 /LETTERS
"Z-"A+1
2000
"A-"9-1 /NUMBERS
"9-"0+1
1000
"0-211-1 /HORIZONTAL TAB
211-211+1
0400
211-215-1 /LF, VT, FF, CR
215-212+1
0200
212-";-1 /! @ # DOLLAR % & ' ( ) * + , - . / : ;
";-"!+1
0100
"!-240-1 /SPACE
240-240+1
0040
240-"@-1 /< = > ? @
"@-"<+1
0020
"<-"_-1 /[ \ ] _
"_-"[+1
0010
"[-377-1 /RUBOUT
377-377+1
0004
377-376-1 /ALTMODE
376-375+1
0002
375-377-1 /EVERYTHING ELSE
377-0+1
0001
*4400
/RFILE AND WFILE IOTS
UFILE, TAD UFILWA /NO, GET USER PARAMETERS
JMS I UFPARM /AND MOVE TO PARAMETER BLOCK
TAD I UFLNKA /ADDRESS OF PARAMETER BLOCK
TAD UFIPIF
DCA UFPARA /POINTS TO WORD 3 OF BLBOCK
DATFLD
TAD I UFPARA /CLEAR ALL BUT FILE # IN BLOCK
AND C0003
DCA I UFPARA /SAVE IT
TAD L2SA /ADDRESS OF USER PARAMETERS
TAD UFIPWC /+2
DCA UFILE1 /POINTS TO WORD COUNT IN USER AREA
TAD I UFPARA /FILE #
SIFIL1, CDF
TAD UFJF0 /RELATIVE ADDRESS OF FILE 0 POINTER
DCA UFJOBF /RELATIVE ADDR OF FILE POINTER FOR THIS FILE
GETJTW
UFJOBF, 0 /POINTER TO FILE CONTROL INFO
SNA
JMP UFILER+1 /FILE NOT OPEN
DCA UFJOBF /SAVE POINTER TO FILE CONTROL
DATFLD
TAD I UFPARA /FILE #
JMS I UFIGJF /GENERATE CORRESPONDING FILE BIT IN STR1
DCA UFIJSF /FILE STATUS FLAG
TAD L2SF /USER'S FIELD #
AND C0007
CLL RTL /*4
DCA JOBSWA /SAVE
TAD I UFPARA /GET FILE # + ORIGINATING STATUS INFO
AND C7743 /CLEAR FIELD #
TAD JOBSWA /SET FIELD #
DCA I UFPARA /SAVE IN PARAMETERS
TAD UFJOBF /SAVE GLOBAL PARAMETERS
IAC /POINTS TO WORD 2 OF CONTROL BLOCK
DCA AXS1 /CONTROL INDEX
CLL CLA CMA RTL /AC:=-3
TAD UFPARA
DCA AXS2 /PARAMETER INDEX POINTS TO START OF PARAMETERS-1
TAD I AXS2 /WRITE AND PROTECTED?
AND I AXS1
AND C0004 /CHECK ONLY FOR WRITE PROTECT
SZA CLA
JMP UFILER /YES - ERROR
TAD AXS2 /NO, SET FILPAR = START OF PARAMETER BLOCK
DCA I AXS1
TAD I AXS2 /DISC EXTENSION FROM PARAMETERS
DCA I AXS1 /TO CONTROL BLOCK
ISZ AXS2 /SKIP FIELD
TAD I AXS2 /SAVE WC
DCA JOBSWA
ISZ AXS2 /SKIP CORE ADDRESS FOR NOW
TAD I AXS2 /DISC ADDRESS
DCA I AXS1 /TO CONTROL BLOCK
TAD UFIRET /RETURN ADDRESS
DCA I AXS2 /TO PARAMETER BLOCK
TAD UFJOBF /POINTER TO FILE CONTROL
DCA I AXS2 /TO PARAMETER BLOCK
TAD JOBSWA /WORD COUNT
DCA I AXS1 /TO CONTROL BLOCK
TAD UFILE1 /POINTS TO WC IN USER AREA
SNA /IS THIS AN SI REQUEST?
JMP .+3 /YES
DCA I AXS1 /NO, SAVE POINTER TO WC IN CONTROL BLOCK
DCA L2SA /CLEAR USER AC
TAD UFJOBF /POINTER TO CONTROL BLOCK
TAD UFPAR2 /+3
DCA UFILPA /POINTS TO POINTER IN CONTROL BLOCK POINTING TO PARAM. BLOCK
TAD UFJOBF /POINTS TO FILE CONTROL
JMS I UFILIX /GET SEGMENT INDEX
JMP I UFIL4A /NOT IN CORE - DO A WINDOW TURN
JMP UFILE2 /NON-EXISTENT DISC ADDRESS
JMS I UFICTB /OK, SET UP TRANSFER BLOCK - POINTER TO SEGMENT # IN AC
UFILPA, 0 /POINTER TO FILPAR
TAD I UFILPA /ADDRESS OF PARAMETERS
JMS I UFIQUE /QUEUE THE REQUEST IN DSUTBL
ISZ DSBUSY /DISC BUSY?
SKP /YES
JMS I FIUSER /NO, START TRANSFER
TAD UFIJSF /CLEAR FILE STATUS BIT
UUOEXT /EXIT
SIFILE, DATFLD /HANDLE SI FILE TRANSFERS
TAD UFIPIF
DCA UFPARA /POINTS TO FILE # IN PARAMETERS
DCA UFILE1
TAD I UFPARA /GET FILE #
AND C0003 /ONLY FILE #
JMP SIFIL1 /REST IS SAME AS USER PROGRAMS
UFILE2, GETJTW /NON-EXISTENT DISK ADDRESS
JOBLNK /GET ADDRESS OF PARAMETERS
DCA UFILE1 /SAVE IT
JMP .+3
UFILER, IAC /PROTECTED
IAC /NOT OPEN
TAD C0002 /EOF
CDF
JMS I UFERR /FILE ERROR ROUTINE
UFILE1, 0 /POINTS TO PARAMETER BLOCK
TAD UFILE1
RETBLK /RETURN PARA BLK
CLA
TAD CURJOB /DID WE BUMP SOMEONE ELSE OFF?
SZA CLA
WAIT /YES - GO BACK TO HIM/HER
UUOEXT /NO - BACK TO THIS USER
UFPARA= WS0 /ADDR OF USER PARAMETERS
UFIJSF= WS1 /FILE STATUS FLAG
C7743, 7743
UFILWA, UFILCT
UFJF0, JOBF0
UFPAR2= C0003 /FILPAR
UFIPIF= C0002 /FILPIF
UFIPWC= C0002 /FILPWC
UFPARM, GETUSP
UFLNKA, UUOLNK
UFERR, FILERR
UFILIX, FILIX
UFIRET, DSURET
UFICTB, FILCTB
UFIGJF, GETJFX
UFIQUE, DSQUE
UFIL4A, UFILE4
RKL20, CIF DATFLD-1
JMP I .+1
RKL21
/RETURN CONTENT OF JOB STATUS FOR CURRENT JOB
/CALL
/ GETJTW
/ RELATIVE ADDRESS OF WORD
/ RETURN (CONTENTS IN AC, ABSOLUTE ADD IN JOBSWA)
GETJW0, 0
TAD I GETJW0 /GET RELATIVE ADDRESS
DCA .+3 /SAVE IT
TAD CJOBDA /POINTER TO CURRENT JOB STATUS
GETJTI /GETCONTENTS
0
ISZ GETJW0 /INDEX RETURN
JMP I GETJW0
*4600
/RETURN NUMBER OF NEXT RUNNABLE JOB IN AC
/CALL JMS NXTJOB
/ RETURN WITH JOB # IN AC
FILCDA,
NXTJCT, 0
NXTJBN, 0 /NEXT JOB #
NXTJMM, -JOBMAX
FILCT2,
NXTJOB, 0
DCA FIT /CLEAR FIT
TAD BONUS /IS THERE ANY JOB BROKEN OUT OF KEYBOARD WAIT?
RUNABL /IS IT RUNNABLE?
JMP NXTJ1 /NO, GET THE NEXT JOB
TAD BONUS /THIS JOB
JMP I NXTJOB
NXTJ1, ISZ NXTJCT /HAVE WE TRIED ALL JOBS?
SKP /NO, KEEP GOING
SCHED /TRY FOR A RESIDENT JOB
TAD NXTJBN /IS IT TIME TO WRAP AROUND TO JOB 1?
TAD NXTJMM
SNA CLA
DCA NXTJBN /YES
ISZ NXTJBN /INCREMENT NUMBER OF JOB UNDER CONSIDERATION
NXTJ2, TAD NXTJBN /IS THE JOB RUNNABLE?
RUNABL
JMP NXTJ1 /NO, CONTINUE JOB TABLE ROUND ROBIN
TAD NXTJBN /YES, RETURN WITH JOB NO. IN AC
JMP I NXTJOB
/CONSTRUCT TRANSFER BLOCK
/CALL TAD SEGMENT WINDOW POINTER
/ JMS FILCTB
/ POINTER TO FILPAR
FILCPD= C0004 /FILPDA-FILPDX
FILCWC= C7776 /FILPWC-FILPDA
FILCSW= JOBSWA /POINTER TO SEGMENT WINDOW
FILCPA= WS2 /POINTER TO FILPAR & FILDA
FILCWA, 0
FILCPX, 0 /POINTER TO FILPDX, FILPDA & FILPWC
FILCTB, 0
DCA FILCSW /SAVE POINTER TO SEGMENT IN WINDOW
TAD I FILCTB
DCA FILCPA /ADDRESS OF POINTER TO PARAMETER BLOCK
ISZ FILCTB /SKIP ARGUMENT IN CALL
DATFLD
TAD I FILCPA /GET ADDRESS OF PARAMETERS
IAC /POINTS TO WORD 2 OF PARAMETERS
DCA FILCPX
ISZ FILCPA /POINTS TO DISK EXTENSION IN CONTROL BLOCK
CLA CMA
TAD I FILCSW /GET SEGMENT #
CLL RAR
RTR
RTR /MULTIPLY BY 400 SEG SIZE
DCA FILCT2 /SAVE "PRODUCT"
TAD FILCT2
RAL
AND SEGSM1 /THROW OUT CONTRIBUTION FROM HI ORDER BITS OF EXTENSION
TAD FIBAS1 /START OF LOGICAL FILE AREA
CLL RTL
DCA I FILCPX /SAVE IN DISK EXTENSION IN PARAMETER BLOCK
TAD FILCT2 /NOW GET LOW ORDER ADDRESS
AND SEGLMK
DCA FILCT2 /AND SAVE IT
TAD FILCPX /SET DISC ADDRESS
TAD FILCPD
DCA FILCPX /POINTS TO LOW ORDER ADDRESS IN PAR. BLOCK
TAD FILCPA
IAC
DCA FILCDA /POINTS TO LOW ORDER ADDRESS IN CONTROL BLOCK
TAD I FILCDA /GET WORD ADDRESS SUPPLIED BY USER
AND SEGSM1 /(WORD IN SEGMENT)
TAD FILCT2 /+ WORD ADDRESS FROM SEGMENT ARITHMETIC
DCA I FILCPX /SAVE IT IN PARAMETER BLOCK
TAD FILCPX /SET WORD COUNT
TAD FILCWC
DCA FILCPX /POINTS TO WORD COUNT IN PARAMETER BLOCK
DCA I FILCPX /NOTHING TRANSFERRED YET
TAD FILCDA
IAC
DCA FILCWA /POINTS TO WORD COUNT IN CONTROL BLOCK
FILCT1, TAD SEGSM1 /SEGS12-1
AND I FILCDA /LOW ORDER ADDRESS IN CONTROL BLOCK
DCA FILCT2 /DISC ADDRESS MOD SEGS!Z
TAD I FILCWA /GET -WC FROM CONTROL BLOCK
CLL CIA /+WC
TAD FILCT2 /IF WE DO ENTIRE WC WILL WE GO INTO NEXT
AND SEGLMK / SEGMENT?
SNA CLA
SZL
JMP FILCT3
TAD I FILCWA /NO
JMP .+3
FILCT3, TAD SEGLMK /SUBTRACT SEGS12 FROM WC, SO WE STAY IN SAME SEGMENT
TAD FILCT2
DCA FILCT2 /WORD COUNT FOR TRANSFER
TAD FILCT2 /UPDATE WORD COUNT IN PARAMETER BLOCK
TAD I FILCPX /OLD VALUE
DCA I FILCPX /NEW VALUE
TAD FILCT2 /UPDATE WORD COUNT IN FILE CONTROL BLOCK
CIA /+WC
TAD I FILCWA /OLD -WC
DCA I FILCWA /NEW -WC
TAD I FILCWA /ARE WE DONE?
SNA CLA
JMP I FILCTB /YES
TAD FILCT2 /INCREMENT DISC ADDRESS
CLL CIA /+WC
TAD I FILCDA /OLD DISC ADDRESS
DCA I FILCDA /NEW DISC ADDRESS
SZL /OVERFLOW?
ISZ I FILCPA /YES - INDEX DISC EXTENSION
TAD I FILCSW /GET CURRENT SEGMENT #
CLL CMA /-(SEGMENT # +1)
DCA FILCT2 /SAVE IT
ISZ FILCSW /POINTS TO NEXT SEGMENT IN WINDOW
TAD FILCSW /ARE WE STILL IN THE WINDOW?
AND C0007
SZA CLA /NEXT POINTER IN CORE?
JMP FILCT4 /YES, SEE IF NEXT SEGMENT IS CONTIGUOUS
TAD BASWIN /NO, IS IT BASIC?
TAD FILCSW /COMPARE THE WINDOW ADDRESS WITH BASIC WINDOW ADDRESS
SNL CLA
JMP I FILCTB /NO, RETURN
FILCT4, TAD I FILCSW /GET THE NEXT SEGMENT
TAD FILCT2 /CONTIGUOUS SEGMENTS?
SNA CLA
JMP FILCT1 /YES - CONTINUE THE TRANSFER
JMP I FILCTB /RETURN
FIBAS1, SWDEX+JOBMAX
/TAKE CARE OF DUPLEX AND UNDUPLEX IOT'S
UDUP, TAD C0200 /DUPLEX BIT IN DDB WORD 1
UUND, DCA WS0 /WS0 CONTAINS BIT TO ADD FOR BOTH IOT'S
TAD JOB
TTYUSE /FIND INPUT DDB
DCA WS1 /ADDRESS OF DDB
DATFLD
TAD I WS1 /WORD ONE OF DDB
AND C7577 /CLEAR DUPLEX BIT
TAD WS0 /SET IT AS CALLED FOR
DCA I WS1
UUOEXT
C7577, 7577
*5000
/TELEPRINTER IOT'S
UTELC= WS0
UTEL, JMS UKT0 /FIND THE CONSOLE # ATTACHED TO JOB
ISZ CONDBA /POINT TO OUTPUT SIDE
UULPT, TAD UJSTEL /TTY FLAG
UUPTP, DCA UOUTFL /SAVE THE DEVICE'S FLAG
JMS UKT1 /WHAT IS REQUESTED BY USER?
JMP UTELS /SEND A STRING (6XX0)
UOUTFL, JSTEL /DEVICE FLAG POSITION IN STR1
JMP I UTELS1 /UNCONDITIONAL SKIP ON USER "TSF, PSF, OR LSF"
SNA CLA /6XX4 OR 6XX2
UUOEXT /6XX2 - IF WE CLEAR FLAGS WE MAY DIE
TAD L2SA /6XX4
DCA TTCHAR
PRINT /OUTPUT THE CHARACTER
SKP /NO ROOM - REDO LATER
UUOEXT /OK - ALL DONE
STA /BACK UP HIS/HER PC
TAD L2SV0
DCA L2SV0
JMP UTELS6
UTELS5, DCA L2SA /CLEAR USER'S AC
TAD UKT0 /KEEP HIM/HER RUNNING IF WE WERE ABLE TO ACCEPT ANY CHARACTERS
SNA CLA
UTELS6, TAD UOUTFL /MAKE HIM/HER WAIT FOR DEVICE FLAG
UUOEXT /AND AWAY
UJSTEL, JSTEL
UKT0, 0
TAD JOB
TTYUSE /GET ADDR OF INPUT DDB
DCA CONDDB /SAVE IT
DATFLD /GET CONTENTS OF FIRST WORD OF DDB
TAD I CONDDB /UNIT # + FLAGS IN AC
CDF
AND C1000
SNA CLA /CONSOLE IN SI MODE?
JMP I UKT0 /NO - OK TO CONTINUE
GETJTW
JOBWMK
CLA
DATFLD
DCA I JOBSWA /CLEAR HIS/HER WAIT MASK TO HANG HIM/HER UP
REDO /SI WILL WAKE HIM/HER UP TO TRY AGAIN LATER
UJSPTP= C0004
/ "SEND-A-STRING"
UTELS, UDF /SELECT USER'S FIELD
TAD I L2SA
SNA CLA
JMP UTELS4 /USER'S W.C. IS ZERO - SO SEND NOTHING
DCA UKT0
TAD L2SA
IAC
DCA UTELC /POINTS TO ADDRESS OF STRING IN USER AREA
TAD I UTELC /GET ADDRESS-1 OF STRING
DCA AXS2 /SAVE POINTER TO STRING
UTELS3, TAD I AXS2 /GET CHARACTER FROM USER
CDF
DCA TTCHAR
PRINT /OUTPUT THE CHARACTER
JMP UTELS5 /BUFFER FULL
UDF
ISZ I UTELC /BUMP ADDRESS IN USER AREA
ISZ UKT0 /DOESN'T MATTER THAT WE MAY SKIP THIS
ISZ I L2SA /BUMP USER'S WORD COUNT
JMP UTELS3 /KEEP GOING
UTELS4, DCA L2SA /ALL DONE --- CLEAR USER AC
JMP I UTELS1 /EXIT AND SKIP
UTELS1, UUOEX2
/LINE PRINTER UUO'S
ULPT, JMS I UPTLPA
DEVTBE+3 /LINE PRINTER POSITION IN DEVTBL
TAD .-1
DCA CONDBA /IT'S OK TO USE THE PRINTER
TAD UJSTEL /LPT FLAG (20+20=40)
JMP UULPT
/PAPER TAPE PUNCH UUO'S
UPTP, JMS I UPTLPA /OK TO USE PUNCH?
DEVTBE+1 /PUNCH'S POSITION IN THE DEVTBL
TAD .-1
DCA CONDBA /PASS ON THE PUNCH'S POSITION
TAD UJSPTP /PUNCH FLAG
JMP UUPTP
UPTLPA, DEVCHK
/ROUTINE TO ANALYZE IOT'S
/CALLING SEQUENCE:
/ IOT IN UUOCAL
/ JMS UKT1
/ RETURN FOR STRING IOT
/ FLAG TO CHECK IN STR1
/ RETURN FOR NON-SKIPPING FLAG TESTS
/ RETURN FOR EVENT TIMES 2 AND 4 (AC=BIT 9 OF IOT; LINK=BIT 10)
/ ILLEGAL MICRO-CODING RESULTS IN "NOP"
/ SKIPPING FLAG RESULTS IN INCREMENT OF USER PC
UKT1, 0
TAD UUOCAL
AND C0007
SNA /STRING?
JMP I UKT1 /YES
ISZ UKT1
CLL RAR /NO
SNL /SKIP TEST?
JMP UKT12 /NO
SZA CLA /YES - ANYTHING ELSE?
UUOEXT /YES - BAD MICRO-CODING
GETJTW /GET HIS/HER STR1
JOBSTS+1
AND I UKT1 /FLAG TO CHECK
CLL RTR /IGNORE THE ERROR FLAG
ISZ UKT1 /INDEX PAST ARGUMENT
SNA CLA /FLAG SET?
JMP I UKT1 /NO - DON'T SKIP
JMP I UTELS1 /YES - SKIP ON EXIT
UKT12, ISZ UKT1
ISZ UKT1
CLL RAR
JMP I UKT1 /INDEX RETURN
UUOERR, CDF /SET "ILLEGAL IOT" ERROR CODE
TAD JOB
ERROR
UUOERF /CODE=1
USYN, WAIT /AND BACK TO THE SCHEDULER
USTMT1= WS0
SLEEP, TAD JOB
SNA CLA /PROBABLE TROUBLE DUE TO EAE
EXIT
TAD C0002
DOUSTM, CIA /NEGATE
DCA DDSTM1 /SAVE - # UNITS OF TIME
TAD JOB /SET CLKTBBL ENTRY FOR THIS JOB
TAD CLKTBA
DCA USTMT1 /POINTS TO THIS JOB'S ENTRY
TAD DOSTM1
DATFLD
DCA I USTMT1 /SET TABLE ENTRY
STL RAR /SET AC=JSTIME
UUOEXT /EXIT AND WAIT
DOSTM1, 0
CLKTBA, CLKTBL /JOB TIMER TABLE ADDRESS
*5171
OVERLA, SKP /ERROR
JMP I OVER1A /OK, FINISH UP
TAD I FANCOR /GET NUMBER OF JOB IN TROUBLE
ERROR /PASS ERROR TO USER
DSKERR
JMP I OVER1A /NOW FINISH UP
OVER1A, OVERL1
/NULL JOB IS THE ONLY INSTRUCTION IN FIELD 0 WHICH
/IS EXECUTED IN USER MODE.
/IT IS RUN WHENEVER THERE IS NOTHING ELSE
/TO DO, OR NOTHING ELSE THAT CAN BE DONE.
/
/WHEN DEBUGGING THE MONITOR, IT IS POSSIBLE
/TO STOP (VIA THE PDP-8 OPERATOR CONSOLE) THE MONITOR
/TO ENTER XDDT. THIS MAY ONLY BE DONE
/WHEN THE SYSTEM IS IN NULJOB. IF THE
/SYSTEM IS STOPPED WHEN NOT IN NULJOB, IT MAY
/BE RESTARTED BY HITTING "CONTINUE," AND THEN
/STOPPED AGAIN. KEEP TRYING - EVENTUALLY YOU'LL CATCH IT.
/DO NOT STOP THE SYSTEM (AND EXPECT TO GET AWAY WITH IT)
/IF ANY I/O IS IN PROGRESS.
/IF THE SYSTEM IS STOPPED IN NULJOB, IT MAY BE
/RESTARTED AT LOCATION 4201 IN FIELD 0.
NULJOB, JMP . /IT'S A BIGGY, ISN'T IT?