File MCR.PA (PAL assembler source file)

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

/MCR FOR RTS8				LAST EDITED 1/11/74
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/ 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. TASK= MCR CUR= 10 INIWT= 0 IFNDEF MCRSYS <MCRSYS=1> /DEFAULT INCLUDES SYSTAT /PARAMETERS FOR SOMEWHAT FANCIER NULL TASK WHICH COMES WITH MCR TASK2= NTASKS+1 /LOWEST PRIORITY TASK IN SYSTEM - UNADDRESSABLE CUR2= CUR /SAME FIELD AS MCR INIWT2= 0 /COMES UP RUNNING INLENG= 52 /LENGTH OF INPUT BUFFER NMFIT= 34 /NUMBER OF NAMES WHICH CAN SHARE A PAGE WITH CODE FIELD CUR%10 *100 ERRDLM, DLMER ERRNUM, NUMER ERRNAM, NAMER GET, GETA NUMB, 0 /GETN RESULT ENDSTF, ENDS BCKUP, BACKUP LEGLIM, LEGAL EOL, EOLA ACL, 0 /2 WORD AC ACH, 0 Q, 0 /ALL USAGE TEMPS V, 0 P, 0 PUTW= JMS I . PUTWX
*MCRSYS^7600+5400 IFNDEF CLOCK <*.+600> /3 PAGES FOR CLOCK CODE IFNZRO NTASKS-NMFIT&4000 <*.+200> /SAVE NAME PG /GET NEXT CHARACTER ROUTINE /ADVANCE POINTER FOR NEXT GET GETA, 0 TAD I IP ISZ IP JMP I GETA IP, 0 /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 PUTWX, 0 /ROUTINE TO STORE A WORD IN THE OUTPUT BUFFER DCA I W ISZ W JMP I PUTWX
/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 BACKUP, 0 /BACK UP INBUF POINTER BY 1 CHAR CLA CMA TAD IP DCA IP JMP I BACKUP 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
TTOUT, 0 PUTW /TERMINATE LINE CAL SENDW TTY /SEND MESSAGE TO TTY AND WAIT EXMSG TAD (E1MSG /INITIALIZE POINTER FOR NEXT LINE DCA W JMP I TTOUT W, E1MSG EXMSG, ZBLOCK 3 /OUTPUT BUFFER SHARES SPACE WITH INPUT BUFFER 0 0 E1MSG, INBUF, ZBLOCK INLENG /INPUT BUFFER PAGE
/ROUTINE TO PARSE OFF A TASK NAME OR NUMBER NAMEA, XNAME XNAME, 0 /USED FOR TEMP STORAGE OF ACCUMULATED NAME XNAME1, 0 GETTSK, 0 /THIS SUBR RETURNS TASK NUMBER IN "TSKWD" JMS NAMGET 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 AC7776 DCA G3 TAD (4040 DCA XNAME1 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 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 TAD (NMTBL-1 DCA P TAD (-NTASKS-1 DCA V CHKMOR, ISZ P /UPDATE PAST UNNEED INFO 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 ISZ NAMCOM /FOUND IT JMP I NAMCOM
/RUN THE REQUESTED TASK. TO SCHED FIRST IFNDEF CLOCK < SCHED, JMS GETTSK > REQUST, IFDEF CLOCK <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 IOF /"WAITM" REQUIRES IOF ON ENTRY CDF CIF 0 TAD (4000+TASK DCA I (MCREF CDF CUR /SUSPEND MCR ON ^C EVENT FLAG WAITM /WITHOUT LETTING INTERRUPTS GO BACK ON! EFWT START, CAL SENDW TTY MCRMES TAD PINBUF 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 MCRMES, ZBLOCK 3 2000+INLENG PINBUF, INBUF L7600, TEXT />/ START2, TAD L7600 /RSX-11D STYLE NULL TASK BKGLP, ISZ BKGCT ISZ BKGCT ISZ BKGCT ISZ BKGCT ISZ BKGCT JMP BKGLP RAR JMP BKGLP BKGCT, 0
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 TTY ERMSG JMP 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/
/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 IFDEF CLOCK < -0401; DATEX /DATE -2411; TIME /TIME -0301; CANCEL /CANCEL > -2205; SCHED /REQUEST -1720; EXAM /OPEN -0405; DEPSIT /DEPOSIT -2017; POSTEF /POST IFNZRO MCRSYS < -2331; SYSTAT /SYSTAT > -0530; EXIT /EXIT 0; NAMER /END OF LIST PAGE
/FORMAT OF NMTBL IS 2 WORDS OF 4 6-BIT CHARS /ORDERED BY NUMBER OF TASK AFFILIATED WITH THAT NAME /NAMES MUST BE PADDED WITH BLANKS! NMTBL, ZBLOCK NTASKS^2 NAMES= NMTBL-2 *MCR^2+NAMES 1503; 2240 /MCR IFDEF TTY < *TTY^2+NAMES 2424; 3140 /TTY > IFDEF CLOCK < *CLOCK^2+NAMES DEVICE CLCK > IFDEF RK8 < *RK8^2+NAMES 2213; 7040 /RK8 > IFDEF DTA < *DTA^2+NAMES 0424; 0140 /DTA >
/NAME TABLE CONTINUED IFDEF RF08 < *RF08^2+NAMES DEVICE RF08 > IFDEF CSA < *CSA^2+NAMES 0323;0140 /CSA > IFDEF CSAF < *CSAF^2+NAMES DEVICE CSAF > IFDEF UDC < *UDC^2+NAMES 2504;0340 /UDC > IFDEF OS8F < *OS8F^2+NAMES DEVICE OS8F > IFDEF OS8 < *OS8^2+NAMES 1723; 7040 /OS8 > IFDEF LPT < *LPT^2+NAMES 1420;2440 /LPT > IFDEF PWRF < *PWRF^2+NAMES DEVICE PWRF > *NTASKS^2+NMTBL /ORIGIN TO END OF TABLE IFZERO NTASKS-NMFIT&4000 <PAGE> /CAN'T FIT IN WITH CODE
/ASSOCIATE A NAME WITH A TASK NUMBER NAME, JMS I (GETTSK /GET TASK NUMBER TO GIVE THIS NAME TO RAL CLL /INDEX INTO NMTBL 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 JMP I ENDSTF EXIT, TAD I (XNAME1 TAD (-1124 /VERIFY THAT "EXIT" WAS TYPED SZA CLA JMP I (EXAM /OTHERWISE ASSUME USER MEANT "EXAMINE" CDF 0 DCA I (TSWFLG /INHIBIT TASK SWITCHING ISZ V JMP .-1 /ALLOW (MOST) I/O TO COMPLETE ISZ EXDLAY JMP .-3 IOF CDF CIF 0 JMP I (7600 EXDLAY, -60
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 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 / O= EVENT OR MESSAGE SYSTAT, DCA V JMS I BCKUP JMS I LEGLIM JMP I ERRDLM JMP FULSYS /NO ARGS - DO FOA ALL TASKS, NO STATE JMS I (GETTSK /DELIMITER - GET TASK ID DCA V DCA P /SET FOR ONE TASK, WITH STATE JMP ONETSK FULSYS, TAD (-NTASKS DCA P /-MAX. NO. ENTRIES UPCHCK, ISZ V ONETSK, TAD (TFTABL TAD V 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 V /PRINT TASK NO. JMS I (PRNTNM JMS SYSOUT TAD V CLL RAL TAD (NAMES /INDEX INTO NAME TABLE DCA ST1 TAD I ST1 JMS SYSOUT /ADD NAME TO WRITE BUFFER ISZ ST1 TAD I ST1 JMS 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 V 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 V /PRINT 4 WORDS FROM TASK STATE TABLE ENTRY CLL RTL /FOR THIS TASK TAD (TSTABL DCA ST1 JMS SYSOUT TAD ST1 JMS I (PR12BT /PRINT LOCATION OF JOB STATE TABLE ENTRY TAD (7240 /FOLLOWED BY COLON, SPACE PRDTLP, JMS 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 SYSOUT, 0 SNA /PRINT CONTENTS OF AC TAD (4040 /OR BLANKS. PUTW JMP I SYSOUT ST1, 0 ST2, 0 FLGTBL, MSGWT; 4015 /M EFWT; 4005 /E RUNWT; 4022 /R SWPWT; 4023 /S USERWT; 4025 /U ENABWT; 4004 /D EORMWT; 4017 /O 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
IFDEF CLOCK < 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 ACL 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 IOF /INHIBIT INTERRUPTS BETWEEN HALVES CDF 0 TAD I (TODL DCA ACL TAD I (TODH /GET TIME OF DAY FROM PAGE 0 OF FIELD 0 DCA ACH ION /RE-ENABLE INTERRUPTS CDF CUR TAD (FUDGEL JMS DBLSUB /TAKE OFF THE MIDNIGHT FUDGE HRLOP, TAD (HRCON /SUBTRACT HRS TIL OVERFLO JMS DBLSUB ISZ HRS TAD ACH SMA CLA /AC GOES NEGATIVE ON OVERFLOW JMP HRLOP MINLOP, TAD (MINCON JMS DBLADD ISZ MINS TAD ACH SPA CLA /THIS TIME AC GOES POSITIVE 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 TAD I Q TAD ACL DCA ACL ISZ Q /PREPARE FOR HI WORD RAL /UPDATE HI WORD TAD ACH TAD I Q DCA ACH JMP I DBLADD DBLSUB, 0 /** CAN BE CALLED WITH DF=CUR OR DF=0 ** DCA Q CIF CUR /INHIBIT INTERRUPTS BETWEEN HALVES TAD I Q /GET LO VALUE CIA CLL TAD ACL DCA ACL ISZ Q /UPDATE FOR HI VALUE CML RAL TAD I Q CIA TAD ACH DCA ACH JMP I DBLSUB 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 BET 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 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 ACL /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 I (HRMIN /DECODE TIME SPECIFICATION TAD (TODL CDF 0 JMS I (DBLSUB /SUBTRACT CURRENT T.O.D. TO GET INTERVAL CDF CUR SAVTIM, TAD ACH DCA SCHDHI TAD ACL 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 ACL 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 CANCEL, 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 ACL /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 ** CIA DCA S2 MORUNT, TAD S1 /PASS UNITS FOR ADD JMS I (DBLADD ISZ S2 JMP MORUNT 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 S2, 0 S1, 0 SCHMES, ZBLOCK 3 SCHDWD, 0 /2000+TASK NUM SCHDHI, 0 SCHDLO, 0 RSCHHI, 0 RSCHLO, 0 /RESCHEDULE INTERVAL (IF APPLICABLE)
/COMPUTE THE NUMBER OF TICKS IN A DAY FOR THE TIME-OF-DAY FUDGE TEMPH=3^SHERTZ%40 FUDGEL, -600^SHERTZ FUDGEH, -25^SHERTZ-TEMPH-1 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 TAD FUDGEH DCA ACH /INITIALIZE AC TO MIDNIGHT FUDGE TAD FUDGEL /BEFORE WE ADD IN TICKS DCA ACL TAD HRMIN JMP FNDINT /CONVERT MINUTES TO TICKS AND RETURN PAGE > $$$



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