File MCRX.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
/					EDITED DEW  7/31/74




/COPYRIGHT  (C)  1974 BY DIGITAL EQUIPMENT CORPORATION

/ M. HURLEY / R. LARY / D. WREGE /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. /THIS VERSION CONTAINS TASK CALL UTILITIES AND TASK /IMPLEMENTED COMMANDS. ALSO CONDITIONAL ASSEMBLIES WILL /ALLOW MCRX TO KNOW ABOUT XOD.. THE FOLLOWING DEFS SHOULD /BE INCLUDED IN "PARAM.PA": / IFDEF MCR < /MCRSYS=1 /1 IF MCR SYSTAT FACILITY DESIRED /XOD=1 /1 IF WANT MCR TO KNOW ABOUT XOD /XODFLD=10 /RESIDENCE FIELD OF XOD /XODENTRY=6400 /MCR ENTRY TO XOD / > 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= 24 /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
IFNZRO XOD <IFZERO XODFLD-CUR < ADJUST=7600-XODENTRY>> IFNDEF ADJUST <ADJUST=0> *MCRSYS^7600+4600-ADJUST 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 XFLD, 0 GFLD, HLT JMP I XFLD PAGE
/COMMAND CLEANUP AND NEW COMMAND FETCH ENDS, TAD I (CRALT /DID WE REACH EOL? SNA CLA /SKIP IF WE DID JMP .+4 /NO: ^C OR MESSAGE WAIT DCA I (MSGUSR /CLEAR MORE USER MESSAGE ISZ I (CRALT /ALT-MODE EXIT? JMP I (START /NO: CR EXIT ENDZ, CDF 0 TAD (4000+TASK /SET ^C FLAG DCA I (MCREF /TO WAITING STATE WTLOOP, IOF /FOR DELICATE CODE CDF 0 /TO GET FLAGS IN FIELD 0 TAD I (MCREF /CHECK FOR ^C EVOKED SNA CLA /SKIP IF NOT JMP I (START /GO START UP MCR TAD I (TASK^2+MSGTBL /ANY MESSAGES? SZA CLA /SKIP IF NONE JMS I (GETMSG /GO PROCESS MESSAGES CDF CUR /BACK TO THIS FIELD CIF 0 /FOR EORMWAIT WAITM /GO INTO MULTIPLE WAIT EORMWT JMP WTLOOP /ARISE:I GOT SOMETHING TO DO /COME HERE FOR "STANDARD" MCR COMMAND SEARCH STARTX, CDF CUR /CAN COME HERE WITH ARBITRARY FIELD 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 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/
/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 IFNZRO XOD < -3017;XODCAL /XOD > 0; NAMER /END OF LIST PAGE
/COME HERE AT STARTUP TIME.. TO GET TTY STUFF. START, CAL /SEND MESSAGE TO TTY SENDW /TO GET COMMAND TTY /WITHOUT WAITING TTYEF, MCRMES /FOR MCR JMP TTYSTR /GO PROCESS COMMAND /PROCESS A COMMAND FROM TTY TTYSTR, ION TAD (INBUF DCA I (IP /SET UP BUFFER POINTER DCA I (CRALT /AND INIT CR/ALTM SWITCH 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 JMS I BCKUP /FOUND MEAT - BACK OVER IT JMS I (NAMGET /GET COMMAND NAME JMP I ERRNAM /BAD SYNTAX JMS SRUSER /SEARCH USER COMMANDS FIRST JMP I (STARTX /GO DO REGULAR COMMANDS /WE HAVE FOUND A USER COMMAND - SO POST THE MESSAGE /FLAG AND DO AN APPROPRIATE RETURN. ISZ MSGUSR /SET "HAVE USER MESSAGE" FLAG TAD I (NXTCDF DCA .+4 /GET READY TO POST THE MSG TAD P /PICK UP EF POINTER CAL POST CDF /EF FIELD JMS MORINP /CHECK FOR MORE TTY INPUT JMP I (ENDZ /AND GO BACK TO WAIT STUFF MSGUSR, 0 /NON-ZERO IF HAVE SOME USER MESSAGE LEFT /SUBROUTINE TO FIX UP MSGUSR MORINP, 0 TAD I (CRALT SNA CLA JMP I MORINP /IS MORE DCA MSGUSR /NO MORE=CLEAR FLAG JMP I MORINP
/SEARCH USER COMMANDS /THE COMMAND LIST IS A LINKED LIST MUCH LIKE THE MESSAGE /QUEUE. THESE MESSAGES THEREFORE LOOK LIKE / WORD 1 TASKNUM (+4000) / WORD 2 CDF NXTMSG / WORD 3 NXTMSG / WORD 4 1 /USER COMMAND REQUEST / WORD 5 COMMND /IN PACKED ASCII /CALL: TAD (COMMAND TYPED / JMS I (SRUSER / RETRN1 /WAS NOT IN LIST / RETRN2 /WAS IN LIST SRUSER, 0 TAD I (XNAME /GET NAME CIA /ALLOW USERS TO USE POS COMMANDS DCA SRUCMD /SAVE FOR COMPARISON TAD (CFRSX /INIT LINKED LIST DCA PRVP /PRVP POINTS TO MSG+1 JUST CHECKED TAD CDFCUR /INIT FIELD OF START Q RCVLP, DCA PRVCDF /SAVE PREVIOUS Q ENTRIES' FIELD TAD I PRVP /PICK UP CDF QUEUE (NEXT) SNA /IF=0 THEN DONE JMP SRUEXT /NOT A USER COMMAND DCA NXTCDF /SET CDF NXT MESSAGE CLA IAC /POINTER TO 2ND WORD OF Q-POINTER TAD PRVP /IS CONSTRUCTED AND SAVED DCA PRVP2 /FOR POSSIBLE COMMAND REMOVAL TAD I PRVP2 /GET POINTER TO NEXT IN LIST DCA NXTPT /SET POINTER TAD (4 /4 DOWN IS USER COMMAND TAD NXTPT /CALC ADDRESS DCA P /PNTR TO COMMAND NXTCDF, CDF /TO NEXT MSG FIELD TAD I P /GET COMMAND TAD SRUCMD /CHECK AGAINST COMMAND ISZ NXTPT /POINT TO CDF NEXT+1 SNA CLA /SKIP IF NO MATCH JMP GOTIT /EURIKA!! TAD NXTPT /MAKE NEXT (I.E. THIS) DCA PRVP /=PREVIOUS TAD NXTCDF /AND FIELD JMP RCVLP /GO ON WITH NEXT GOTIT, TAD I NXTPT /HAVE ENTRY; FIRST REMOVE IT DCA P /SAVE CDF NXT NXT ISZ NXTPT /PNT TO NXT NXT PTR TAD I NXTPT /GET IT PRVCDF, CDF /TO PREVIOUS FIELD DCA I PRVP2 /STASH FOR REMOVAL TAD P /GET CDF NXT NXT DCA I PRVP /MESSAGE REMOVED STA CLL RAL /BACK UP GOOD MSG PNTR TAD NXTPT /TO TOP OF MSG DCA P /SET P FOR RETURN ISZ SRUSER /TAKE SECOND RETURN SRUEXT, CDFCUR, CDF CUR JMP I SRUSER NXTPT, 0 PRVP, 0 PRVP2, 0 SRUCMD, 0 /USER REQUEST = 2 /GET A DECIMAL NUMBER FROM TTY INPUT LINE. /AND STICK IN MESSAGE QUE /MSG FMT ZBLOCK 3 / 2 /USER REQUEST / 0 /SET TO NEG IF NONE THERE / NUMB /RETURNED USREQ2, TAD I (MSGUSR /IS THERE ANY USER MESSAGE? SNA CLA /SKIP IF YES SKP /NO: ERROR CONDITION JMS I (GETDEC /GET A DECIMAL NUMBER SKP /WAS NONE=ERROR CLA SKP /GET RID OF DELIMITER STA JMS I (XFLD /TO MESSAGE FIELD DCA I P /INDICATE ERROR OR NO ISZ P /TO WHERE NUMBER GOES TAD NUMB /PICK UP NUMBER DCA I P /EXIT FROM USER REQUESTS USREQE, CDF CUR /BACK TO THIS FIELD TAD I (GFLD /GET USER FIELD DCA .+4 TAD I (GMSGP /AND PICK UP MESSAGE FLAG CAL POST GFLD /USER MESSAGE FIELD JMP I (GETMEX /USER REQEST 11 /GET A TASK NUMBER /THIS IS NOT CURRENTLY IMPLEMENTED AS NEED TO FIX UP /ERROR RECOVERY STUFF. USREQ9, JMS I (GETTSK /GET TASK JMS I (XFLD /TO MSG FLD DCA I P /STICK IN MSG BODY JMP USREQE /DONE. PAGE
/COME HERE TO PROCESS USER REQUESTS. /HERE WE DO UTILITY BRANCHING GETMSG, 0 CAL /ASK RTS8 FOR MESSAGE RECEIVE /THERE HAS TO BE ONE GMSGP, 0 /RECIEVES MESSAGE POINTER DCA I (GFLD /FOR OTHER ROUTINE'S USE TAD GMSGP /PICK UP MESSAGE POINTER DCA P /SAVE FOR SUBSEQUENT ROUTINES STA CLL RTL /BACK UP MESSAGE POINTER TAD GMSGP /TO BEGINNING DCA GMSGP /FOR LATER POINTER JMS I (XFLD /TO MESSAGE FIELD TAD I P /PICK UP FUNCTION WORD CDF CUR /BACK TO CURRENT ISZ P /POINT TO BODY OF MESG AND (17 /MASK FUNCT WORD TAD (USRBTB-1 /INDEX INTO TABLE DCA Q /STASH POINTER TAD I Q /GET ADDRESS DCA Q /ALMOST THERE JMP I Q /GO PROCESS COMMAND /RETURN FROM USER UTILITY REQUEST GETMEX, JMS I (MORINP JMP I (ENDZ
/USER HAS REQUESTED A USER COMMAND TO BE ENTERED IN /LIST ... I.E. FUNCTION = 1. NEWCMD, ISZ GMSGP /POINT TO HEAD+1 JMS I (XFLD /TO MESSAGE FIELD TAD CFRSX /SYPHON INTO LIST DCA I GMSGP /STICK IN CDF NEXT TAD CFRSX+1 /AND POINTER NEXT ISZ GMSGP DCA I GMSGP CDF CUR /NOW START LIST WITH THIS MSG TAD I (GFLD /PICK UP USER CDF DCA CFRSX /HAVE THE CDF STA CLL RAL /-2 TO TOP OF MSG TAD GMSGP /POINTER DCA CFRSX+1 /PUT THAT ONE IN JMP GETMEX /AND RETURN TO PROPER PLACE CFRSX, 0 /BEGINNING OF THREADED USER COMMAND 0 /MESSAGE LIST.. IFNZRO CFRSX-NEWCMD&7600 <BDCFRS,+> /MUST BE IN PAGE WITH NEWCMD
/SUBROUTINE TO GET A DECIMAL NUMBER FROM INPUT TTY BUFFER. /MAX SIZE=4095 (SINGLE PRECISION FOR NOW. /CALL: JMS I (GETDEC / RET1 /NOT THERE / RET2 /GOT ONE DELIM IN AC GETDEC, 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 GETDEC /TAKE RETURN 1 GETNXL, JMS I GET JMS I (ISITNM JMP YSITIS+1 JMP I GETDEC /RETURN WITH DELIMITER IN AC YSITIS, ISZ GETDEC /HAVE NUMB CAN TAKE SECOND RETURN 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 /CONVERT A SINGLE PRECISION DECIMAL NUMBER TO ASCII /AND STICK INTO OUTPUT BUFFER. DO NOT OUTPUT. /IGNORE LEADING ZERO'S. NUMBER IS UNSIGNED AND IN AC. PRNDEC, 0 DCA NUMB /SAVE THE NUMBER DCA NULOUT /FOR CHECKING LEADING ZEROS TAD (MTHOUS /INIT DIGITS DCA P /P IS SUBTRACTION POINTER TAD (-5 /4 DIGITS MAX DCA V /V IS COUTER DCA DIG /CLEAR THIS DIGIT PRNDE1, TAD NUMB /GET NUMBER LEFT TAD I P /SUBT POWER OF 10 SPA /SKIP IF NOT THERE YET JMP PRNDE2 /GOT NEXT DIGIT DCA NUMB /UPDATE NUMBER ISZ DIG /COUNT UP DIGIT JMP PRNDE1 /AND TRY AGAIN PRNDE2, CLA /GARBAGE IN AC ISZ V /SKP WHEN DONE SKP JMP PRNDE3 /DONE ISZ P /INDEX TO NEXT POWER OF 10 TAD DIG /GET DECIMAL DIGIT TAD NULOUT /TO IGNORE LEADING ZEROS SNA CLA /SKIP IF TO BE PRINTED JMP PRNDE1 /NO: TRY NEXT POWER ISZ NULOUT /FROM NOW ON WE PRINT TAD DIG /PICK UP DIGIT TAD (60 /ADD IN ASCII JMS PRNDIG /OUTPUT IT JMP PRNDE1-1 /AND GO DO NEXT CHAR PRNDE3, TAD NULOUT /IF ALL OUTPUT NULL SZA CLA /THEN PRINT ONE ZERO JMP .+3 /WAS SOME OUTPUT SO EXIT TAD (60 /PRINT ONE 0 JMS PRNDIG /AND PRINT TAD (40 /FORCE OUT RMAINING DIGITS JMS PRNDIG DCA OUTDG /AND CLEAR FOR NEXT CALL JMP I PRNDEC /AND EXIT /OUTPUT DIGITS PRNDIG, 0 TAD OUTDG SPA /SKIP IF NOT YET PUTW /OUTPUT 2 DIGITS CLL RTL;RTL;RTL /INTO LEFT HALF DCA OUTDG JMP I PRNDIG OUTDG, 0 NULOUT, 0 /ALLOWS IGNORING LEADING 0'S DECIMAL MTHOUS, -1000;-100;-10;-1 OCTAL PAGE
/USER COMMAND = 4 /PRINT A DECIMAL NUMBER.. /MSG FMT ZBLOCK 3 / 4 /REQUEST / NUMBR /TO BE PRINTED USREQ4, TAD (4040 /PAD A LITTLE PUTW /FOR MULTIPLE NUMBS JMS I (XFLD /TO MESSAGE FIELD TAD I P /GET NUMBER TO CONVERT CDF CUR /BACK TO THIS FIELD JMS I (PRNDEC /PRINT THE DECIMAL NUMBER JMS I (FORCLN /AND OUTPUT THE NUMBER, IF REQUESTED JMP I (USREQE /AND EXIT /USER REQUEST = 3 /IF ANY INPUT THEN GET A DECIMAL NUMBER /IF NOT THEN PRINT DECIMAL NUMBER. /MSG FMT ZBLOCK 3 / 3 /USER REQ 3 / NUMB /RETURNED OR TO BE PRINTED USREQ3, TAD I (MSGUSR /ANY MORE INPUT? SNA CLA /SKIP IF YES JMP USREQ4 /NO: PRINT NUMBER JMS I (GETDEC /GET DECIMAL NUMBER JMP USREQ4 /NONE THERE SO PRINT USER'S CLA CLL /NOT INTERESTED IN DELIMITER JMS I (XFLD /CHANGE TO MESS AGE FIELD TAD NUMB /PICK UP THE NUMBER DCA I P /STASH IN MESSAGE JMP I (USREQE /AND END REQUEST /USER REQUEST 5 /GET AN OCTAL NUMBER /MSG FMT ZBLOCK 3 / 5 /REQUEST / 0 /RECIEVES NEG IF NONE / 0 /RECIEVES NUMBER USREQ5, STA JMS I (XFLD /TO MESSAGE FIELD STA DCA I P /ZAP THE ERROR INDICATOR TO ERROR CDF CUR TAD I (MSGUSR /ANY USER MESSAGE LEFT? SNA CLA /SKIP IF THERE IS JMP I (USREQE /NO:RETURN WITH ERR JMS I (OCTNM8 /GET OCTAL NUMBER JMP I (USREQE /NONE THERE JMP USRQ5A /A GOOD ONE JMS I (D07 /SHOULD NOT BE ANOTHER DIGIT JMP USRQ5A /WAS O.K. JMS I (BCKUP JMS I (EOLA /TOO MANY DIGITS=END LINE JMP I (USREQE /AND ERROR RETURN USRQ5A, JMS I (XFLD /TO MESSAGE FIELD DCA I P /CLEAR ERROR INDICATOR ISZ P /TO NUMBER RECIEVER TAD NUMB /GET NUMBER DCA I P /AND STASH JMP I (USREQE /AND RETURN /USER REQUEST 7 /PRINT AN OCTAL NUMBER USREQ7, TAD (4040 PUTW /PAD A LITTLE JMS I (XFLD /TO MESSAGE FIELD TAD I P /GET NUMBER CDF CUR JMS I (PR12BT /AND PRINT IT JMS I (FORCLN /FORCE OUT LINE, IF REQUESTED JMP I (USREQE /AND RETURN /USER REQUEST 6 /GET/PRINT AN OCTAL NUMBER USREQ6, TAD I (MSGUSR /ANY USER MESSAGE LEFT? SNA CLA /SKIP IF YES JMP USREQ7 /NO: PRINT IT JMS I (OCTNM8 /FETCH OCTAL JMP USREQ7 /NONE THERE=PRINT IT JMP USRQ6A /A GOOD ONE JMS I (D07 /MAY BE TOO MANY JMP USRQ6A /GOOD. ONLY 4 JMP USREQ7 /TOO MANY DIGITS SO PRINT ONE USRQ6A, JMS I (XFLD /TO MESSAGE FIELD TAD NUMB /GET NUMBER DCA I P /STASH IN MESSAGE JMP I (USREQE /AND FINISH UP /USER REQUEST 10 /PRINT DATE/TIME ON CONSOL USREQ8, TAD (4040 /A LITTLE PADDING PUTW JMS I (PRNDAT /OUTPUT DATE TAD (4040 PUTW /SOME PADDING JMS I (PRNTIM /OUTPUT TIME JMP I (USREQE /AND RETURN /DO AN ENDSTF RETURN USREQA, TAD (USRQUT DCA I (GETMSG JMP I (USREQE /POST EVENT FLAG GIVEN ADDRESS POSTEF, JMS I (GET2OC /GET 5-DIGIT ADDRESS SKP /SHOULD BE ONLY 1 NUMBER JMP I ERRNUM /MORE IS ERROR TAD I (GFLD DCA POSTDF TAD I (G2A CAL POST /PRAY WHAT WE ARE POSTING IS REALLY POSTDF, HLT /AN EVENT FLAG JMP I ENDSTF
/FUNCTION DESTINATION BRANCH LIST USRBTB, NEWCMD /1 = USER MCR COMMAND USREQ2 /2 = GET DECIMAL USREQ3 /3 = GET/PRINT DECIMAL USREQ4 /4 = PRINT DECIMAL USREQ5 /5 = GET OCTAL USREQ6 /6 = GET/PRINT OCTAL USREQ7 /7 = PRINT OCTAL USREQ8 /10= PRINT DATE/TIME USREQA /11= DO ENDSTF RETURN GETMEX /UNIMPLEMENTED GETMEX GETMEX GETMEX GETMEX /UNIMPLEMENTED GETMEX XODCALL,IOF /CALL XOD CIF XODFLD /LEAVE DATA FIELD = FIELD OF CALL JMS I (XODENTRY USRQUT, ION /"R" COMMAND RETURNS HERE CLA CLL /IN CASE XOD HAD AC. JMS I BCKUP /TO BE SURE TO GET EOL. JMS I (EOLA JMP I ENDSTF 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 > /FOR G.EWELL IFDEF ADC < *ADC^2+NAMES 0104;0340 > IFDEF WIND < *WIND^2+NAMES DEVICE WIND > IFDEF TIMER < *TIMER^2+NAMES DEVICE TIME > IFDEF AVG < *AVG^2+NAMES 0126;0740 > IFDEF CUMU < *CUMU^2+NAMES DEVICE CUMU > IFDEF TM8E < *TM8E^2+NAMES DEVICE TM8E > IFDEF TM8EC < *TM8EC^2+NAMES DEVICE TM8C > IFDEF DAC < *DAC^2+NAMES 0401;0340 > IFDEF SCAN < *SCAN^2+NAMES DEVICE SCAN > *NTASKS^2+NMTBL /ORIGIN TO END OF TABLE IFZERO NTASKS-NMFIT&4000 <PAGE> /CAN'T FIT IN WITH CODE
/SUBROUTINE TO FORCE OUT LINE DEPENDING ON USER REQUEST. /BIT 0 SET IN REQUEST MEANS NO FORCE YET. FORCLN, 0 TAD (3 /SO WORKS ON CLASSIC-8 TAD I (GMSGP /CALC POINTER TO REQUEST DCA PRNTNM /FOR TEMP JMS I (XFLD /TO USER MESSAGE FIELD TAD I PRNTNM /GET FUNCTION WORD CDF CUR /BACK TO THIS FIELD SMA CLA /SKIP IF NO OUTPUT REQUEST JMS I (TTOUT /FORCE LINE AS HE WANTS JMP I FORCLN /AND RETURN /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 I (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
/GET A SINGLE OCTAL NUMBER AND ERREXIT /IF DIGIT NOT OCTAL. NORMAL RETURN IF L.T. 4 DIGITS /RET+1 IF 4 DIGITS OCTNUM, 0 JMS OCTNM8 JMP I ERRNUM JMP I OCTNUM ISZ OCTNUM JMP I OCTNUM /MAKE AN OCTAL NUMBER /CALL: JMS OCTNM8 / RET1 /BAD NUMBER / RET2 /GOOD NUMBER L.T. 4 DIGITS / RET3 /GOOD NUMBER 4 DITITS OCTNM8, 0 AC7775 DCA V DCA NUMB /INITIALIZE NUMBER JMS D07 /GET A DIGIT JMP I OCTNM8 /RET = ERROR ISZ OCTNM8 /SECOND RET TWOMOR, JMS D07 /CAN HAVE UP TO 4 DIGITS JMP I OCTNM8 /L.T. 4 ISZ V JMP TWOMOR ISZ OCTNM8 /4 DIGITS JMP I OCTNM8 /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 I (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 I (GFLD /ACROSS FIELD BOUNDARY DCA I (GFLD JMP I BUMP
/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 I (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 I (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 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, JMS PRNTIM JMP I ENDSTF /PRINT TIME AS SUBROUTINE PRNTIM, 0 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 PRNTIM 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 /GET A SINGLE PRECISION DECIMAL NUMBER. /IS LIKE GETNUM EXCEPT ONLY ONE RETURN AND AUTOMATIC /ERROR ON NO NUMBER. RESULT IS IN NUMBER. GETN, 0 /GET A NUMBER ROUTINE JMS I (GETDEC /CALL GET DEC NUMB ROUTINE JMP I ERRNUM /AN ERROR JMP I GETN /RETURN WITH DELIMITER
/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, JMS PRNDAT JMS I (TTOUT /PUT OUT LINE JMP I ENDSTF /PRINT DATE - AS SUBROUTINE - DON'T PUT OUT LINE PRNDAT, 0 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 JMP I PRNDAT /AND RETURN 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