File MCR.PA (PAL assembler source file)

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

/ NON-RES MCR FOR RTS8 V2B			3/23/77

	VERS=	1	/MCR VERSION NUMBER
	VERS2=	1	/NULL TASK VERSION NUMBER


/ M. HURLEY / R. LARY
/THE MONITOR CONSOLE ROUTINE ALLOWS THE OPERATOR/PROGRAMMER
/OF AN RTS-8 SYSTEM TO CONTROL AND OBSERVE THE STATE OF THE
/SYSTEM THROUGH THE CONSOLE TELETYPE.

/
/EDIT HISTORY
/
/	MADE NON-RESIDENT-ABLE LATE DEC, 1975
/	4-JAN-76   FIXED BUG RE RE TO EARLIER TIMES
/	3-MAY-76   ADDED 'MCRFLD' AND 'MCRCLK'
/		   ADDED DECNET/8 NAMES TO NAME TABLE
/	14-JUN-76	ADDED TLK, LSN
/	02-OCT-76	FIXED TIMING PROBLEMS
/			ADDED 'MCRCDV' PARAMETER
/			INCREASED INPUT BUFFER IF USING
/			NULL8A NULL TASK
/			ADDED TTY2 AND EXIT TO NAME TABLE
/			MODIFIED 'EXIT' CODE
/01-DEC-76:  (LHN)
/	1)  80 COLUMN LPT: CREF LISTING.
/	2)  ADDED CONDITIONAL CODE WHEN "MCRDMP"=1 TO ENABLE
/		A)  THE DUMP (DU) COMMAND.
/		B)  THE FI COMMAND.
/	3)  CHANGED THE NULL TASK CONDITIONAL TEST.
/	4)  ADDED "B" FOR DEBUG WAIT IN THE STATUS LIST.
/	5)  MODIFIED "SYSTAT" CODE TO LIST UP TO 127 TASKS.
/	6)  ADDED 6 CHARACTER NAMES WHEN "MCR6CN" =1.
/	7)  MODIFIED TEST FOR NAME LIST TO SHARE PAGE.



IFNDEF	MCRFLD	<MCRFLD=10>
IFNDEF	MCRLOC	<MCRLOC=5200>
IFNDEF	MCRBLK	<MCRBLK=MCRLOC+200>




	TASK=	MCR
	CUR=	MCRFLD
	INIWT=	0

/ IFNDEF MCRCDV <MCRCDV=TTY> /TTY IS DEFAULT IFNDEF CLOCK <MCRCLK=0> IFDEF CLOCK <IFNDEF MCRCLK <MCRCLK=1> > IFNDEF MCRSYS <MCRSYS=1> /DEFAULT INCLUDES SYSTAT IFNDEF MCR6CN <MCR6CN=0> /DEFAULT TO 4 CHAR NAMES IFNDEF MCRDMP <MCRDMP=1> /DEFAULT INCLUDES DUMP IFNDEF EAE <EAE=0> /JUST IN CASE / FIRST PAGE IS RESIDENT AND SHOULD NOT BE MULTIPLE OF 400 / USER SHOULD DEFINE 'MCRLOC' IN PARAM FILE IF HE WANTS TO / SPECIFY LOCATION. IF HE DOESN'T THEN MCR WILL PUSH UP / AGAINST END OF FIELD 1 / / IF 'MCRPRT' IS DEFINED IN THE PARAMETER FILE, THEN THE / USER WANTS THE MCR TO BE NON-RESIDENT AND 'MCRPRT' IS / ITS PARTITION NUMBER. IFDEF MCRPRT < PARTNO=MCRPRT CPABLE=0 WRITE=1 > / PARAMETERS FOR SOMEWHAT FANCIER NULL TASK WHICH COMES / WITH MCR IFNDEF NULL < TASK2= NTASKS+1 /LOWEST PRIORITY TASK IN SYSTEM - / UNADDRESSABLE CUR2= CUR /SAME FIELD AS MCR INIWT2= 0 /COMES UP RUNNING > /******** / PARAMETERS WHICH DEPEND ON SPACE FREE IN MCR PAGES: INLENG= 40 /LENGTH OF INPUT BUFFER (USED TO BE 54) IFNDEF TASK2 <INLENG=INLENG+26> IFDEF TASK2 <IFZERO EAE <INLENG=INLENG+14> > / CHECK THEM WHENEVER EDITING CODE! /********
/ FIELD CUR%10 *MCRPGZ ERRDLM, DLMER ERRNUM, NUMER ERRNAM, NAMER GET, GETA NUMB, 0 /GETN RESULT ENDSTF, ENDS BCKUP, BACKUP LEGLIM, LEGAL EOL, EOLA ACLW, 0 /2 WORD AC ACH, 0 Q, 0 /ALL USAGE TEMPS V, 0 P, 0 PUTW= JMS I . PUTWX
/ / RESIDENT PORTION OF MCR: / *MCRLOC MCRMES, ZBLOCK 3 2000+INLENG PINBUF, INBUF L7600, TEXT />/ IFDEF TASK2 < START2, TAD L7600 /RSX-11D STYLE NULL TASK BKGLP, ISZ BKGCT ISZ BKGCT IFNZRO EAE <JMP MQDPY> ISZ BKGCT ISZ BKGCT ISZ BKGCT JMP BKGLP RAR JMP BKGLP BKGCT, 0 IFNZRO EAE < / MQ DISPLAY ROUTINE / / THIS CODE IS CALLED FROM THE 'NULL' TASK IN THE / MCR, AND PUTS THE SELECTED CORE LOCATION IN THE / MQ REGISTER. THE FIELD OF THE DISPLAY IS / SET BY THE FIELD (FI) COMMAND. / / 0 MQDPY, DCA START2 /SAVE THE AC OSR /READ THE SWITCH REGISTER AND SAVE DCA MQDPY-1 /THE VALUE AS AN INDIRECT MQFLD, CDF 0 /SET THE REQUIRED DATA FIELD TAD I MQDPY-1 /READ THE SELECTED CORE LOCATION CDF CUR /RESET THE DATA FIELD TO HERE MQL /MOVE THE DATA TO THE MQ REGISTER CLA /JUST IN CASE MQL FAILS TAD START2 /RESTORE THE AC JMP BKGLP+3 /RETURN TO THE 'NULL' TASK > >
/ ERMSG, ZBLOCK 3 /STANDARD MESSAGE HEADER 1000 /SIXBIT MESSAGE, END WITH CRLF, / INDIRECT 0 /NO INPUT ERRA, 0 /JMS PUTS POINTER TO ERROR / MESSAGE HERE CAL /AC RANDOM BUT IRRELEVANT SENDW+FREE MCRCDV ERMSG JMP I (START CHRER, JMS ERRA TEXT /BAD CHAR/ NAMER, JMS ERRA TEXT /BAD NAME/ DLMER, JMS ERRA TEXT /BAD DELIM/ NUMER, JMS ERRA TEXT /BAD NUMBER/
/GET NEXT CHARACTER ROUTINE /ADVANCE POINTER FOR NEXT GET GETA, 0 TAD I IP ISZ IP JMP I GETA IP, 0 BACKUP, 0 /BACK UP INBUF POINTER BY 1 CHAR CLA CMA TAD IP DCA IP JMP I BACKUP PUTWX, 0 /ROUTINE TO STORE A WORD IN THE DCA I W / OUTPUT BUFFER ISZ W JMP I PUTWX /V2B-A W, E1MSG TTOUT, 0 PUTW /TERMINATE LINE CAL SENDW+FREE MCRCDV /SEND MESSAGE TO TTY AND WAIT EXMSG TAD (E1MSG /INITIALIZE POINTER FOR NEXT LINE DCA W JMP I TTOUT EXMSG, ZBLOCK 3 /OUTPUT BUFFER SHARES SPACE WITH 0 / INPUT BUFFER 0 E1MSG, INBUF, ZBLOCK INLENG /INPUT BUFFER PAGE
/ NON-RESIDENT PORTION OF MCR: *MCRBLK IFDEF MCRPRT <IFNZRO .&0200 <MCRBLK, _ERROR_ >> /ERROR IF NON-RESIDENT PORTION OF MCR /DOES NOT START AT A MULTIPLE OF 400. /ROUTINE TO PARSE OFF A TASK NAME OR NUMBER NAMEA, XNAME XNAME, 0 /USED FOR TEMP STORAGE OF ACCUMULATED NAME XNAME1, 0 XNAME2, 0 /V2B-A GETTSK, 0 /THIS SUBR RETURNS TASK NUMBER IN JMS NAMGET / "TSKWD" JMP NUMTSK JMS NAMCOM /OK SO FAR. /NOW CHECK FOR NAME DUPLICATION JMP I ERRNAM TAD V TAD (NTASKS+1 /GET NUMBER ASSOC. WITH THIS NAME GOTASK, DCA TSKWD /AND THAT'S THE TASK NUMBER TAD TSKWD CIA CLL TAD (NTASKS /MUST BE BETWEEN 1 + NTASKS SNL CLA JMP I ERRNUM TAD TSKWD JMP I GETTSK /RETURN WITH TASK NUMBER IN AC NUMTSK, JMS I BCKUP /IT'S A NUMBER - MUST BACK UP PTR JMS I (OCTNUM /SO GO ACCUMULATE IT JMS I BCKUP JMS I GET /GET DELIMITING CHAR CLA TAD NUMB JMP GOTASK
/ NAMGET, 0 TAD NAMEA DCA G7 IFZERO MCR6CN <AC7776> /V2B-A IFNZRO MCR6CN <AC7775> DCA G3 TAD (4040 DCA XNAME1 TAD (4040) /V2B-A DCA XNAME2 JMS I (ALPNUM /ONLY ALPHAS + NUMBERS LEGAL JMP I (CHRER TAD (-300 SPA CLA /NAME OR NUMBER? JMP I NAMGET /BY NUMBER ISZ NAMGET TAD Q NXT, AND (77 STL RTL /40 IN LOW 6 BITS RTL RTL DCA I G7 JMS I (ALPNUM JMP ENDX /2ND CHAR IS NOT ALPHANUMERIC AND (77 TAD (-40 /REMOVE LOW 40 TAD I G7 DCA I G7 /SAVE 1ST 2 CHARS ISZ G7 ISZ G3 /4 (0R 6) CHARS YET? JMS I (ALPNUM JMP ENDX /3RD CHAR NON-ALPHANUMERIC JMP NXT /GO DO 3RD+4TH CHARS ENDX, JMS I BCKUP END, JMS I LEGLIM JMP END NOP JMP I NAMGET G3, 0 G7, 0 TSKWD, 0
/COMPARE NAME IN XNAME WITH NMTBL, LOOKING FOR MATCHES. NAMCOM, 0 IFZERO MCR6CN <TAD (NMTBL-1> IFNZRO MCR6CN <TAD (NMTBL-2> DCA P TAD (-NTASKS-1 DCA V CHKMOR, ISZ P /UPDATE PAST UNNEED INFO IFNZRO MCR6CN < /V2B-A ISZ P > ISZ V /DONE? SKP JMP I NAMCOM /YES TAD I P /GET 2 CHARACTERS FROM NMTBL ISZ P CIA TAD XNAME /COMPARE TO NAME UNDER INVESTIGATION SZA CLA JMP CHKMOR /N.G. CONTINUE THRU NMTBL TAD XNAME1 /TRY 2ND 2 CHARS FOR MATCH CIA TAD I P SZA CLA JMP CHKMOR /NOT CLOSE ENOUGH IFNZRO MCR6CN < /V2B-A ISZ P TAD XNAME2 /TRY 3RD 2 CHARS FOR MATCH CIA TAD I P SZA CLA JMP CHKMOR+1 /NOPE, NO MATCH > ISZ NAMCOM /FOUND IT JMP I NAMCOM
/RUN THE REQUESTED TASK. TO SCHED FIRST IFZERO MCRCLK < SCHED, JMS GETTSK > REQUST, IFNZRO MCRCLK <TAD TSKWD> CAL RUN JMP BKELEN /STOP THE REQUESTED TASK STOP, JMS GETTSK CAL SUSPND BKELEN, JMS I BCKUP JMS I EOL JMP I ENDSTF /ENABLE A TASKS EXECUTION ENABLE, JMS GETTSK CAL UNBARG /UNBLOCK THE TASK ON ENABWT /ENABLE WAIT JMP BKELEN /CLEAN UP /DISABLE A TASKS EXECUTION DISABL, JMS GETTSK CAL BLKARG /BLOCK THE TASK ON ENABWT /ENABLE WAIT JMP BKELEN /CLEAN UP PAGE
/COMMAND CLEANUP AND NEW COMMAND FETCH ENDS, ISZ I (CRALT /ALT-MODE EXIT? JMP START /NO-CR EXIT ENDZ, IOF /"WAITM" REQUIRES IOF ON ENTRY CDF CIF 0 TAD (4000+TASK DCA I (MCREF AC4000 /4000 IN AC FREES PARTITION WITH / NEW EXEC CDF CUR /SUSPEND MCR ON ^C EVENT FLAG WAITM /WITHOUT LETTING INTERRUPTS GO EFWT / BACK ON! START, CAL SENDW+FREE MCRCDV MCRMES TAD (INBUF DCA I (IP DCA I (CRALT JMS I LEGLIM /LOOK AT FIRST CHAR JMP .+3 /SOMETHING USEFUL JMP I ENDSTF /CR OR ALT - NULL LINE JMP .-3 /SPACE OR COMMA - KEEP LOOKING / FOR MEAT JMS I BCKUP /FOUND MEAT - BACK UP OVER IT JMS I (NAMGET /GET COMMAND NAME JMP I ERRNAM TAD (CMDLST-1 DCA P CMDLP, ISZ P TAD I P /GET 1ST 2 CHARS OF A COMMAND ISZ P SZA /0 TERMINATES COMMAND LIST TAD I (XNAME SZA CLA /A MATCH? JMP CMDLP /NO-TRY AGAIN TAD I P /YES - GET COMMAND DISPATCH ADDRESS DCA P JMP I P /WE'RE ON OUR WAY
/DETERMINES IF NEXT CHARACTER IS ALPHABETIC OR NUMERIC /EXIT IF NOT; EXIT+1 IF ALPHA OR NUM ALPNUM, 0 JMS I GET DCA Q TAD Q TAD (-333 CLL TAD (32 SZL CLA /TEST FOR ALPHA ISZ ALPNUM /BUMP RETURN IF ALPHA TAD Q /NOW TEST FOR NUMERIC JMS ISITNM ISZ ALPNUM JMP I ALPNUM /SEE IF CHARACTER IN AC IS NUMERAL /EXIT IF IS; EXIT+1 IF NOT ISITNM, 0 TAD (-"9-1 CLL TAD (12 /CHECK FOR RANGE 260-271 SNL ISZ ISITNM /BUMP RETURN ADDRESS IF NOT IN RANGE TAD (260 /RESTORE CHAR JMP I ISITNM
/CHECK NEXT CHAR FOR TYPE OF DELIMITER /EXIT= NOT CR,ALTMODE,SPACE, OR COMMA /EXIT+1=CR OR ALTMODE /EXIT+2=SPACE OR COMMA LEGAL, 0 JMS I GET DCA Q TAD Q CIA CLL SPA /CR OR ALTMODE? JMP NOCRAL /NO STA CML RAL /GENERATE -2 IF CR, -1 IF ALTMODE DCA CRALT JMP ITSEOL NOCRAL, TAD (240 /BLANK? SZA TAD (",-240 /COMMA? SZA CLA JMP NOGOOD /NEITHER ISZ LEGAL /SPACE OR COMMA ITSEOL, ISZ LEGAL /CR,ALT NOGOOD, JMP I LEGAL EOLA, 0 /SEARCH FOR C.R. OR ALTMODE JMS I LEGLIM JMP I ERRDLM /CRAP AT END OF LINE JMP I EOLA JMP EOLA+1 CRALT, 0
/COMMAND LIST - FORMAT OF LIST IS: / NAME / OVERLAY NO. / ST. ADDR. IN OVERLAY CMDLST, -2324; STOP /STOP -0516; ENABLE /ENABLE -0411; DISABL /DISABLE -1601; NAME /NAME IFNZRO MCRCLK < -0401; DATEX /DATE -2411; TIME /TIME -0301; CANCEX /CANCEL > -2205; SCHED /REQUEST -1720; EXAM /OPEN -0405; DEPSIT /DEPOSIT -2017; POSTEF /POST IFNZRO MCRSYS < -2331; SYSTAT /SYSTAT > -0530; EXITT /EXIT IFNZRO MCRDMP < -0425; DUMPIT /CORE DUMP OPTION -0611; MQDFLD /FIELD OF MQ DISPLAY > 0; NAMER /END OF LIST
/ PAGE
/ /FORMAT OF NMTBL IS 2 OR 3 WORDS OF 4 6-BIT CHARACTERS /ORDERED BY NUMBER OF TASK AFFILIATED WITH THAT NAME /NAMES MUST BE PADDED WITH BLANKS! IFZERO MCR6CN <NAMWDS= 2> /NUMBER OF WORDS IFNZRO MCR6CN <NAMWDS= 3> / PER ENTRY. NMTBL, ZBLOCK NTASKS+1^NAMWDS NAMES= NMTBL-NAMWDS *MCR^NAMWDS+NAMES 1503; 2240 /MCR IFNZRO MCR6CN <4040> IFDEF TTY < *TTY^NAMWDS+NAMES 2424; 3140 /TTY IFNZRO MCR6CN <4040> > IFDEF TTY2 < *TTY2^NAMWDS+NAMES 2424; 3162 /TTY2 IFNZRO MCR6CN <4040> > IFDEF CLOCK < *CLOCK^NAMWDS+NAMES IFZERO MCR6CN <DEVICE CLCK> /CLOCK IFNZRO MCR6CN <0314;1703;1340> > IFDEF RK08 < *RK08^NAMWDS+NAMES DEVICE RK08 /RK08 IFNZRO MCR6CN <4040> > IFDEF RK8E < *RK8E^NAMWDS+NAMES DEVICE RK8E /RK8E IFNZRO MCR6CN <4040> > IFDEF DTA < *DTA^NAMWDS+NAMES 0424; 0140 /DTA IFNZRO MCR6CN <4040> >
/ /NAME TABLE CONTINUED / IFDEF LTA < *LTA^NAMWDS+NAMES 1424; 0140 /LTA IFNZRO MCR6CN <4040> > IFDEF SWAPPER < *SWAPPER^NAMWDS+NAMES DEVICE SWAP /SWAP IFNZRO MCR6CN <4040> > IFDEF RF08 < *RF08^NAMWDS+NAMES DEVICE RF08 /RF08 IFNZRO MCR6CN <4040> > IFDEF DF32 < *DF32^NAMWDS+NAMES DEVICE DF32 /DF32 IFNZRO MCR6CN <4040> > IFDEF CSA < *CSA^NAMWDS+NAMES 0323; 0140 /CSA IFNZRO MCR6CN <4040> > IFDEF CSAF < *CSAF^NAMWDS+NAMES DEVICE CSAF /CSAF IFNZRO MCR6CN <4040> > IFDEF UDC < *UDC^NAMWDS+NAMES 2504; 0340 /UDC IFNZRO MCR6CN <4040> > IFDEF ICS < *ICS^NAMWDS+NAMES 1103; 2340 /ICS IFNZRO MCR6CN <4040> >
/ /NAME TABLE CONTINUED / IFDEF OS8F < *OS8F^NAMWDS+NAMES DEVICE OS8F /OS8F IFNZRO MCR6CN <4040> > IFDEF OS8 < *OS8^NAMWDS+NAMES IFZERO MCR6CN <1723; 7040> /OS8SUP IFNZRO MCR6CN <1723;7023;2520> > IFDEF LPT < *LPT^NAMWDS+NAMES 1420; 2440 /LPT IFNZRO MCR6CN <4040> > IFDEF PWRF < *PWRF^NAMWDS+NAMES DEVICE PWRF /PWRF IFNZRO MCR6CN <4040> > IFDEF DDCMP < *DDCMP^NAMWDS+NAMES DEVICE DDCM /DDCMP IFNZRO MCR6CN <2040> > IFDEF NSP < *NSP^NAMWDS+NAMES 1623; 2040 /NSP IFNZRO MCR6CN <4040> > IFDEF TLK < *TLK^NAMWDS+NAMES 2414; 1340 /TLK IFNZRO MCR6CN <4040> > IFDEF LSN < *LSN^NAMWDS+NAMES 1423; 1640 /LSN IFNZRO MCR6CN <4040> >
/ /NAME TABLE CONTINUED / IFDEF NIP < *NIP^NAMWDS+NAMES 1611; 2040 /NIP IFNZRO MCR6CN <4040> > IFDEF RX8A < *RX8A^NAMWDS+NAMES DEVICE RX8A /RX8A IFNZRO MCR6CN <4040> > IFDEF RX8B < *RX8B^NAMWDS+NAMES DEVICE RX8B /RX8B IFNZRO MCR6CN <4040> > IFDEF RX8C < *RX8C^NAMWDS+NAMES DEVICE RX8C /RX8C IFNZRO MCR6CN <4040> > IFDEF RX8D < *RX8D^NAMWDS+NAMES DEVICE RX8D /RX8D IFNZRO MCR6CN <4040> >
/ /NAME TABLE CONTINUED / IFDEF NULL < *NULL^NAMWDS+NAMES DEVICE NULL /NULL IFNZRO MCR6CN <4040> > IFDEF NULL8A < *NULL8A^NAMWDS+NAMES 1625; 1414 /NULL8A IFNZRO MCR6CN <7001> > IFDEF EXIT < *EXIT^NAMWDS+NAMES DEVICE EXIT /EXIT IFNZRO MCR6CN <4040> > IFDEF ODT < *ODT^NAMWDS+NAMES 1724; 2440 /ODT IFNZRO MCR6CN <4040> > / CHECK IF THERE IS ENOUGH ROOM LEFT ON THIS PAGE / AFTER THE NAME LIST FOR THE FOLLOWING CODE. *NTASKS+1^NAMWDS+NMTBL /ORIGIN TO END OF TABLE TEMP= .&177+114 /COMPUTE SPACE LEFT ON PAGE IFDEF EXIT <TEMP= TEMP-7> IFZERO NTASKS-100&4000 <TEMP= TEMP+15> IFNZRO MCR6CN <TEMP= TEMP+6> IFNZRO TEMP&200 <PAGE> /CAN'T FIT WITH CODE
/ASSOCIATE A NAME WITH A TASK NUMBER NAME, JMS I (GETTSK /GET TASK NUMBER TO GIVE THIS NAME RAL CLL /TO INDEX INTO NMTBL IFNZRO MCR6CN < /V2B-A TAD I (TSKWD /TIMES 3 FOR 6 CHAR NAMES > TAD (NAMES DCA ACH JMS I BCKUP JMS I LEGLIM JMP I ERRDLM JMP I ERRDLM /NO CR BEFORE NUMBER JMS I (NAMGET JMP I ERRNAM JMS I (NAMCOM /CHECK FOR DUPLICATION OF NAMES SKP JMP I ERRNAM /BAD NAME - ALREADY EXISTS JMS I BCKUP JMS I EOL TAD I (XNAME DCA I ACH /1 WORD ISZ ACH TAD I (XNAME1 DCA I ACH /THEN THE OTHER IFNZRO MCR6CN < /V2B-A ISZ ACH TAD I (XNAME2 DCA I ACH /AND MAYBE THE THIRD > JMP I ENDSTF EXITT, TAD I (XNAME1 TAD (-1124 /VERIFY THAT "EXIT" WAS TYPED, OTHER- SZA CLA JMP I (EXAM /WISE ASSUME USER MEANT "EXAMINE" IFNDEF EXIT < CDF 0 DCA I (TSWFLG /INHIBIT TASK SWITCHING ISZ V JMP .-1 /ALLOW (MOST) I/O TO COMPLETE ISZ EXDLAY JMP .-3 IOF IFNZRO PDP8E <CAF> CDF CIF 0 JMP I (7600 EXDLAY, -60 >
/ IFDEF EXIT < TAD (EXIT CAL RUN /RUN EXIT TASK IF ONE IS SUPPLIED JMP I (ENDZ /GO AWAY > PR12BT, 0 /PRINT 2 3-BIT NUMBERS DCA Q TAD Q CLL RTR RTR RTR JMS PRNTNM /PASS 2 DIGIT NO. TAD Q JMS PRNTNM /PASS LAST 2 DIGITS JMP I PR12BT PRNTNM, 0 AND (77 DCA V TAD V CLL RTL RAL AND (707 /GET LEFT DIGIT TAD V AND (707 /RIGHT DIGIT TAD (6060 PUTW JMP I PRNTNM SYSOUT, 0 /PRINT CONTENTS OF AC SNA /OR BLANKS FOR SYSTAT TAD (4040) PUTW JMP I SYSOUT
/ / PRINT A 3 DIGIT TASK NUMBER. USED WHEN MORE THAN 63(10) / TASKS ARE DEFINED. IFZERO NTASKS-100&4000 < PRNT3N, 0 DCA V TAD V /TASK NUMBER .GE. 100(8) ? AND (0100) SZA CLA IAC /YES, ADD LEADING "1". TAD (4060) /NO, JUST ADDD LEADING ZERO. PUTW TAD V /NOW FINISH THE TASK NUMBER JMS PRNTNM JMP I PRNT3N > PAGE
/ IFNZRO MCRSYS < /PRINT A STATUS TABLE /FORMAT IS: NO. OF TASK / AFFILIATED NAME IF ANY / STATE OF FLAGS: / E= EVENT M= MESSAGE / S= SWAP R= RUN / U= USER D= DISABLED / B= DEBUG O= EVENT OR MESSAGE SYSTAT, DCA ST3 JMS I BCKUP JMS I LEGLIM JMP I ERRDLM JMP FULSYS /NO ARG - DO FOR ALL TASKS, NO STATE JMS I (GETTSK /DELIMITER - GET TASK ID DCA ST3 DCA P /SET FOR ONE TASK, WITH STATE JMP ONETSK FULSYS, TAD (-NTASKS-1 /V2B-A, TRY FOR "NULL" DCA P /-MAX. NO. ENTRIES UPCHCK, ISZ ST3 ONETSK, TAD (TFTABL TAD ST3 DCA ST2 /INDEX INTO FLAG TABLE CDF 0 TAD I ST2 /GET JFTABL WORD CDF CUR DCA ST2 TAD ST2 /LO BIT=1 MEANS NOT ACTIVE RAR CLL SZL CLA JMP NXTTSK /MOVE ON TO NEXT TASK TAD ST3 /PRINT TASK NO. IFNZRO NTASKS-100&4000 <JMS I (PRNTNM> IFZERO NTASKS-100&4000 <JMS I (PRNT3N> JMS I (SYSOUT TAD ST3 CLL RAL IFNZRO MCR6CN <TAD ST3> /V2B-A TAD (NAMES /INDEX INTO NAME TABLE DCA ST1 TAD I ST1 JMS I (SYSOUT /ADD NAME TO WRITE BUFFER ISZ ST1 TAD I ST1 JMS I (SYSOUT IFNZRO MCR6CN < /V2B-A ISZ ST1 TAD I ST1 JMS I (SYSOUT >
/INSERT TASK WAIT CODES INTO LINE TAD (FLGTBL-1 DCA ST1 /DECODE WAIT CODE FLGLP, ISZ ST1 TAD I ST1 /GET NEXT TABLE ENTRY ISZ ST1 SNA JMP NOMOFG /ZERO ENDS TABLE AND ST2 /IF WE ARE WAITING ON THIS CODE, SNA CLA /WE WILL PUT THE CORRESPONDING CODE / LETTER OUT JMP FLGLP TAD I ST1 PUTW JMP FLGLP NOMOFG, TAD ST3 CLL RAL TAD (MSGTBL DCA Q CDF 0 TAD I Q CDF CUR SNA CLA JMP .+3 TAD (4052 PUTW TAD P SZA CLA JMP NODTL TAD (-4 DCA ST2 TAD ST3 /PRINT 4 WORDS FROM TASK STATE TABLE CLL RTL /ENTRY FOR THIS TASK TAD (TSTABL DCA ST1 JMS I (SYSOUT TAD ST1 JMS I (PR12BT /PRINT LOCATION OF JOB STATE TABLE TAD (7240 /ENTRY FOLLOWED BY COLON, SPACE PRDTLP, JMS I (SYSOUT CDF 0 TAD I ST1 CDF CUR JMS I (PR12BT ISZ ST1 ISZ ST2 JMP PRDTLP
/ NODTL, JMS I (TTOUT /SEND MESSAGE TO TTY NXTTSK, ISZ P /END OF TABLE? TAD P SPA CLA JMP UPCHCK /NO JMP I ENDSTF /YES - GO AWAY ST1, 0 ST2, 0 ST3, 0 /TASK INDEX. FLGTBL, MSGWT; 4015 /M EFWT; 4005 /E RUNWT; 4022 /R SWPWT; 4023 /S USERWT; 4025 /U ENABWT; 4004 /D EORMWT; 4017 /O NONRWT; 4016 /N DEBWT; 4002 /B 0 PAGE >
/GET 2 OCTAL NUMBERS GET2OC, 0 JMS OCTNUM /GO GET A NUMBER JMP ISITDN /LESS THAN 4 DIGITS TAD NUMB /5TH IS FIELD CLL RTR RTR RTR AND (70 DCA G2A /SAVE FIELD POINTER IN CASE 5TH / DIGIT SHOWS JMS D07 /TRY FOR 5 DIGITS JMP ISITDN /BE CONTENT WITH 4 JMS I GET CLA /WASTE A CHAR - THE DELIM TAD G2A /USE THE FIELD WE SAVED ISITDN, TAD (CDF 0 /AC MAY NOT BE 0 HERE! DCA GFLD /SAVE CDF TO FIELD TAD NUMB DCA G2A /THIS IS 4 DIGIT NUMBER JMS I BCKUP JMS I LEGLIM JMP I ERRDLM JMP I GET2OC /LEGAL EOL-ONLY 1 NUMBER JMS OCTNUM /TRY FOR A 2ND JMS I BCKUP TAD NUMB ISZ GET2OC JMP I GET2OC /UPDATE RETURN + PASS 2ND / NUMBER IN AC
/ OCTNUM, 0 AC7775 DCA V DCA NUMB /INITIALIZE NUMBER JMS D07 /GET A DIGIT JMP I ERRNUM TWOMOR, JMS D07 /CAN HAVE UP TO 4 DIGITS JMP I OCTNUM /L.T. 4 ISZ V JMP TWOMOR ISZ OCTNUM /4 DIGITS JMP I OCTNUM /DIGIT MUST BE OCTAL-USE ONLY 3 BITS D07, 0 JMS I GET TAD (-270 CLL TAD (10 DCA BUMP /SAVE DIGIT VALUE SNL JMP I D07 /NOT DIGIT AFTER ALL - NON-SKIP / RETURN TAD NUMB CLL RAL CLL RAL CLL RAL /NUMB*8 TAD BUMP DCA NUMB ISZ D07 /TAKE SKIP RETURN JMP I D07 G2A, 0
/DEPOSIT IN LOCATION SPECIFIED CONTENTS DEPSIT, JMS GET2OC JMP I ERRNUM /MUST HAVE 2 NUMBERS DEPSLP, JMS XFLD /SET FIELD DCA I G2A /ADD IN NEW CONTENTS CDF CUR JMS I LEGLIM JMP I ERRDLM JMP I ENDSTF JMS OCTNUM /MAY BE MORE CONTENTS JMS I BCKUP JMS BUMP /BUMP LOCATION POINTER TAD NUMB JMP DEPSLP BUMP, 0 /ROUTINE TO BUMP G2A ISZ G2A JMP I BUMP /AH, NICE AND SIMPLE TAD (10 TAD GFLD /ACROSS FIELD BOUNDARY DCA GFLD JMP I BUMP /POST EVENT FLAG GIVEN ADDRESS POSTEF, JMS GET2OC /GET 5-DIGIT ADDRESS SKP /SHOULD BE ONLY 1 NUMBER JMP I ERRNUM /MORE IS ERROR TAD GFLD DCA POSTDF TAD G2A CAL POST /PRAY WHAT WE ARE POSTING IS REALLY POSTDF, HLT /AN EVENT FLAG JMP I ENDSTF
/EXAMINE LOCATION OR RANGE OF LOCATIONS EXAM, JMS GET2OC /GET OCTAL VALUES JMS I BCKUP /NO SECOND NUMBER - EXAMINE ONLY / 1 LOC SNA /IF 2D NUM IS ZERO, IAC /EXAMINE ONLY 1 LOC CIA DCA LSTCNT /- NO. OF LOCATIONS TO EXAM JMS I EOL PRNCON, TAD GFLD /GFLD SET BY GET2OC AND (70 CLL RTR RAR TAD (4060 /SPACE , NUMBER PUTW TAD G2A JMS I (PR12BT /PRINT THE LOCATION NEXT TAD (5740 /PRINT A SLASH BEFORE CONTENTS PUTW JMS XFLD /SET FIELD TAD I G2A /GET CONTENTS CDF CUR JMS I (PR12BT /PRINT IT JMS BUMP JMS I (TTOUT /OUTPUT A LINE ISZ LSTCNT /DONE? JMP PRNCON /NO - DO SOME MORE JMP I ENDSTF LSTCNT, 0 XFLD, 0 GFLD, HLT JMP I XFLD PAGE
/ IFNZRO MCRDMP < / / CORE DUMP OPTION / / DU SSSSS,LLLLL / / WHERE SSSSS IS THE STARTING ADDRESS / LLLLL IS THE DESIRED LENGTH TO DUMP / / DUMPIT, JMS I (GET2OC /GET DUMP ADDRESS AND LENGTH JMS I BCKUP /IF ONLY ONE NUMBER TAD (77) /ROUND UP TO NEXT HALF PAGE. CLL RTR /SHIFT TO 'HALF PAGES' RTR RTR AND (0077) /MASK OUT NUMBER OF HALF PAGES SNA /NUMBER ZERO ? IAC /YES, MAKE IT 1. CIA DCA DMPA TAD I (G2A /ROUND STARTING ADDRESS DOWN AND (7770) /TO THE NEXT FULL LINE. DCA I (G2A DMP1, JMS DHEAD /GO OUTPUT A HEADING LINE. JMS MDUMP /GO OUTPUT A DUMP LINE. TAD I (G2A /END OF THIS HALF CORE PAGE ? AND (0077) SZA CLA JMP .-4 /NO, FINISH THIS HALF PAGE. ISZ DMPA /DUMP FINISHED ? SKP /NO, GO ON. JMP I ENDSTF /YES, BACK TO COMMAND MODE TAD I (G2A /THIS CORE PAGE DONE ? AND (0177) SZA CLA JMP DMP1+1 /NO, FINISH IT. JMP DMP1 /YES, DO HEADING AGAIN. DMPA, 0 /LOCAL SCRATCH
/ DHEAD, 0 JMS I (TTOUT /DO CR-LF TAD (4040) /ADD 8 SPACES PUTW TAD (4040) PUTW TAD (4040) PUTW TAD (4040) PUTW DHE1, TAD (6040) DCA P /SAVE THE COLUMN NUMBER TAD (4040) /ADD 3 MORE SPACES. PUTW TAD (4060) /AND A ZERO. PUTW TAD P /PRINT HEADER NUMBER PUTW TAD (100) /INCREMENT THE COLUMN COUNTER TAD P /.GT. 700 ? AND (0700) SZA JMP DHE1 /NO, GO ON JMS I (TTOUT /YES, DUMP LINE JMP I DHEAD
/ / CORE OPTION CONTINUED / MDUMP, 0 CLL CLA TAD (-10) /SET UP A ONE LINE COUNTER. DCA P TAD I (GFLD /OUTPUT FIELD DIGIT AND (70) CLL RTR RAR TAD (4060) /SPACE + DIGIT PUTW TAD I (G2A /OUTPUT LINE STARTING ADDRESS JMS I (PR12BT TAD (4040) PUTW MDMP1, TAD (4040) PUTW TAD I (G2A /GET THE ADDRESS OF NEXT LOCATION DCA Q JMS I (XFLD TAD I Q /GET THE CONTENTS OF NEXT LOCATION CDF CUR JMS I (PR12BT JMS I (BUMP /INCREMENT THE DUMP ADDRESS ISZ P /THIS LINE FINISHED ? JMP MDMP1 /NO, GO AROUND AGAIN. JMS I (TTOUT /EOL, OUTPUT IT JMP I MDUMP /RETURN.
/ / / SET THE FIELD FOR THE MQ DISPLAY / / COME HERE WHEN THE 'FIELD' (FI) COMMAND IS ENTERED / AND CREATE A CDF FOR THE MQ DISPLAY ROUTINE. / / MQDFLD, JMS I (GET2OC /GET THE FIELD DIGIT SKP /SHOULD BE ONLY 1 NUMBER JMP I ERRNUM /MORE THAN 1 IS ERROR TAD NUMB /GET THE ENTERED NUMBER CLL RTL /SHIFT TO FIELD POSITION RAL AND (0070) /MASK OUT THE FIELD DIGIT TAD (CDF 0) /CREATE THE NECESSARY INSTRUCTION IFDEF NULL < CDF 0 /PUT THE FIELD OF INTERST COMMAND DCA I (FIMQDY) /WHERE "NULL" WILL FIND IT. CDF CUR > IFNDEF NULL < IFNZRO EAE < DCA I (MQFLD /OR SAVE IT FOR 'MQDPY' > IFZERO EAE <CLL CLA> /BE NICE !! > JMP I ENDSTF /DONE, RETURN TO COMMAND MODE PAGE > /END OF DUMP CONDITIONAL !!
/ IFNZRO MCRCLK < TIME, TAD I (CRALT SZA CLA JMP PRNTM /PRINT TIME DOTIME, JMS I (HRMIN /DECODE HOURS + MINS TAD I (CRALT SNA CLA JMS I EOL TAD ACLW CDF CIF 0 /INHIBIT INTERRUPTS BETWEEN HALVES DCA I (TODL TAD ACH DCA I (TODH CDF CIF CUR JMP I ENDSTF PRNTM, DCA I (P1 DCA HRS DCA MINS /CONVERT TOD TO HOURS:MINUTES DCA ACH DCA ACLW CDF 0 TAD (TODL JMS DBLADD /GET TIME OF DAY FROM PAGE 0 FIELD 0 TAD (FUDGEL JMS DBLSUB /TAKE OFF THE MIDNIGHT FUDGE HRLOP, TAD (HRCON /SUBTRACT HRS TIL OVERFLO JMS DBLSUB ISZ HRS SZL /LINK IS 0 ON OVERFLOW JMP HRLOP MINLOP, TAD (MINCON JMS DBLADD ISZ MINS SNL /THIS TIME LINK GOES NON-ZERO ON / OVERFLOW JMP MINLOP STA TAD HRS JMS I (PR4BIT ISZ I (P1 /MINS SPLIT BET WORDS TAD MINS CIA TAD (74 JMS I (PR4BIT JMS I (TTOUT JMP I ENDSTF HRS, 0 MINS, 0
/ DBLADD, 0 /DOUBLE PRECISION ADD ROUTINE DCA Q CLL CIF CUR /INHIBIT INTERRUPTS TAD I Q TAD ACLW DCA ACLW ISZ Q /PREPARE FOR HI WORD RAL /UPDATE HI WORD TAD ACH TAD I Q DCA ACH CDF CUR JMP I DBLADD DBLSUB, 0 /** CAN BE CALLED WITH DF=CUR OR DCA Q / DF=0 ** CIF CUR /INHIBIT INTERRUPTS BETWEEN HALVES TAD I Q /GET LO VALUE CIA CLL TAD ACLW DCA ACLW ISZ Q /UPDATE FOR HI VALUE CML RAL TAD I Q CIA TAD ACH DCA ACH CDF CUR JMP I DBLSUB /LINK IS 0 IF RESULT OVERFLOWED GETN, 0 /GET A NUMBER ROUTINE DCA NUMB /INITIALIZE NUMBER TO 0 PSTSPC, JMS I GET JMS I (ISITNM /DIGIT? JMP YSITIS /YES - GO BUILD NUMBER TAD (-240 SNA CLA JMP PSTSPC /PERMIT LEADING SPACES JMP I ERRNUM GETNXL, JMS I GET JMS I (ISITNM SKP JMP I GETN /RETURN WITH DELIMITER IN AC YSITIS, TAD (-260 DCA DIG TAD NUMB CLL RTL TAD NUMB RAL /NUMBER SO FAR *10 TAD DIG /+ NEW NUMBER DCA NUMB JMP GETNXL DIG, 0
/THIS TABLE CONTAINS THE CONVERSION FACTORS FOR HOURS, /MINUTES & SECONDS TO TICKS. EACH IS A 2 WORD VALUE /BECAUSE ALL THIS IS DONE BY DOUBLE WORD ARITHMETIC. /THE HOUR TO TICKS VALUE = 60*60*SHERTZ = 7020(OCT)*SHERTZ /THE LOW WORD VALUE IS DETERMINED FOR THIS MULTIPLICATION /BY THE ASSEMBLER. /THE HIGH WORD IS (7020*SHERTZ)/10000. /THIS MUST BE REDUCED FOR THE ASSEMBLER /IT IS = 341*SHERTZ/400 = 340*SHERTZ/400+SHERTZ/400 = / 7*SHERTZ/10+SHERTZ/400 = (7*SHERTZ+SHERTZ/40)/10 INTTBL, "H HRCON, 7020^SHERTZ HRCTEM= SHERTZ%40 HRCON1, 7^SHERTZ+HRCTEM%10 "M MINCON, 74^SHERTZ MINCN1, 17^SHERTZ%2000 "S SECCON, SHERTZ 0 "T TICCON, 1 0 0 /EOT PAGE
/ DATEX, TAD I (CRALT SZA CLA /PRINT OR GET? JMP PRNTDT /PRINT DATE / DCA DATEWD /WHERE WILL THIS BE?? JMS GETNXT /GET MONTH AND (17 CLL RTR RTR RAR DCA DATEWD /IN STANDARD OS/8 FORMAT JMS GETNXT /HERE COMES DAY AND (37 CLL RTL RAL TAD DATEWD DCA DATEWD JMS I (GETN /FOLLOWED BY YEAR CLA TAD I (DIG /OF WHICH WE TAKE ONLY LAST DIGIT TAD DATEWD CDF 0 DCA I (DATE CDF CUR JMS I BCKUP JMS I LEGLIM JMP I ERRDLM JMP I ENDSTF JMP I (DOTIME /MAY BE FOLLOWED BY TIME
/ GETNXT, 0 JMS I (GETN TAD (-257 SZA CLA /USE / AS DELIM FOR DATE JMP I ERRDLM TAD NUMB JMP I GETNXT DATEWD, 0 PRNTDT, DCA P1 CDF 0 TAD I (DATE CDF CUR DCA DATEWD /SAVE CURRENT DATE TAD DATEWD AND (7400 /GET MONTH CLL RTL RTL RAL JMS PR4BIT CLA CMA DCA P1 /DAY WILL BE SPLIT BETWEEN 2 BUFFER / WORDS TAD DATEWD AND (370 /GET MONTH CLL RTR RAR JMS PR4BIT TAD DATEWD /AND YEAR AND (7 TAD (70 /GOOD TIL 77 JMS I (PRNTNM JMS I (TTOUT /PUT OUT LINE JMP I ENDSTF TENCNT, 0 P1, 0 SPEC, 5700 /SLASH FOR DATE 57 7200 /: FOR TIME 40
/PRINT ROUTINE FOR 4 BIT NUMBERS PR4BIT, 0 DCA Q TAD (57 DCA TENCNT /TENS INITAILLY=0 TAD Q /GET THE DIGITS DECMOR, ISZ TENCNT TAD (-12 SMA JMP DECMOR /COUNT TENS TAD (72 /60+12 DCA Q TAD P1 /SPLIT ACROSS WORDS? SNA JMP REG /NO TAD (SPEC+1 /P1 IS +1 OR -1 DCA P1 /POINT TO CORRECT FILLERS TAD I P1 /YES-GET LEADING CHAR TAD TENCNT PUTW /1ST DIGIT TO RIGHT ISZ P1 TAD Q /2ND DIGIT TO LEFT CLL RTL RTL RTL TAD I P1 /AND 2ND DELIM SAVIT, PUTW JMP I PR4BIT REG, TAD TENCNT CLL RTL RTL RTL TAD Q JMP SAVIT
/ TEMPH=3^SHERTZ%40 FUDGEL, -600^SHERTZ FUDGEH, -25^SHERTZ-TEMPH-1 PAGE
/REQUEST A TASK: /A) IMMEDIATELY /B) AFTER AN INTERVAL /C) AT A TIME OF DAY /D) AFTER AN INTERVAL AND PERIODICALLY /E) AT A TIME OF DAY AND PERIODICALLY SCHED, JMS I (GETTSK /GET TASK JMS I BCKUP JMS I LEGLIM JMP I ERRDLM /MUST BE DELIM JMP I (REQUST /JUST A REQUEST DCA ACH DCA ACLW /INITIALIZE INTERVAL JMS I GET TAD (-", /CHECK FOR NULL INTERVAL SNA JMP SAVTIM /YES - GET PERIOD TAD (",-"@ /CHECK FOR @ TIME-OD-DAY SZA CLA JMP INTSCH JMS HRMIN /DECODE TIME SPECIFICATION TAD (TODL CDF 0 JMS I (DBLSUB /SUBTRACT CURRENT T.O.D. TO GET / INTERVAL SZL JMP SAVTIM TAD (FUDGEL JMS I (DBLSUB SAVTIM, TAD ACH DCA SCHDHI TAD ACLW DCA SCHDLO TAD I (CRALT SZA CLA /END OF LINE SEEN? JMP ZROINT /YES - NO INTERVAL JMS GETINT TAD ACH DCA RSCHHI /SAVE RESCHEDULE UNITS IN CLOCK / MESSAGE TAD ACLW DCA RSCHLO AC2000 ZROINT, TAD (1000 SNDCLK, TAD I (TSKWD DCA SCHDWD CAL SEND CLOCK SCHMES JMP I (BKELEN
/CANCEL ALL CLOCK QUEUE ENTRIES FOR A TASK CANCEX, JMS I (GETTSK /GET TASK - RETURNS NUMBER IN AC / AND "TSKWD" AC4000 /"CANCEL" OPCODE FOR CLOCK HANDLER / IS 4000 JMP ZROINT /SEND THE CLOCK THE CANCEL MESSAGE /ROUTINE TO GET AN INTERVAL - /INTERVALS ARE A NUMBER FOLLOWED BY H,M,S OR T /THIS ROUTINE IS JUMPED INTO BY "HRMIN" GETINT, 0 JMS I (GETN DCA S2 /THIS IS THE ALPHA FOR UNIT TAD (INTTBL DCA S1 DCA ACH DCA ACLW /CLEAR AC PRIOR TO ADDS NXTINT, TAD I S1 /NOW CHECK FOR MATCHING UNITS ISZ S1 SNA JMP I (CHRER CIA TAD S2 SNA CLA JMP FNDINT /FOUND THEM ISZ S1 ISZ S1 JMP NXTINT /TRY AGAIN FNDINT, TAD NUMB /PREPARE COUNT **HRMIN ENTERS HERE** SNA /NEW: CHECK FOR 0 MINUTES JMP NOMIN CIA DCA S2 MORUNT, TAD S1 /PASS UNITS FOR ADD JMS I (DBLADD ISZ S2 JMP MORUNT NOMIN, JMS I LEGLIM JMP I ERRDLM /ILLEGAL TERMINATING DELIMITER SC7000, 7000 /EITHER SPACE, COMMA, OR EOL IS OK JMP I GETINT INTSCH, JMS I BCKUP JMS GETINT /GET INTERVAL JMP SAVTIM SCHMES, ZBLOCK 3 SCHDWD, 0 /2000+TASK NUM SCHDHI, 0 SCHDLO, 0 S1, RSCHHI, 0 S2, RSCHLO, 0 /RESCHEDULE INTERVAL (IF APPLICABLE)
/COMPUTE THE NUMBER OF TICKS IN A DAY FOR THE / TIME-OF-DAY FUDGE HRMIN, 0 /IF SPEC HRS,MUST HAVE MINS JMS I (GETN TAD (-": /ONLY : BET HRS + MINS SZA CLA JMP I ERRNUM /NO : - ERROR TAD HRMIN DCA GETINT /FAKE OUT "GETINT" TO DO SOME WORK / FOR US LATER TAD NUMB /MULTIPLY HRS BY 60 TO GET MINS STL CMA RTL RTL TAD NUMB CLL CMA RTL DCA HRMIN JMS I (GETN /GET MINS JMS I BCKUP TAD (MINCON DCA S1 /SET UNITS TO MINUTES DCA ACLW DCA ACH TAD (FUDGEL JMS I (DBLADD /INITIALIZE AC TO MIDNIGHT FUDGE TAD HRMIN /BEFORE WE ADD IN TICKS JMP FNDINT /CONVERT MINUTES TO TICKS AND RETURN PAGE > /$=$=LHN=$=$



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