.TITLE *** QUEUE COMMAND PROCESSOR *** / / COPYRIGHT (C) 1976 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE / COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION OF THE ABOVE / COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY / NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT / FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. / TITLE TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN / IN DEC. / / THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. / .TITLE *** EDIT LEGEND *** / 100 09-JUN-76 (RCHM) INITIAL IMPLEMENTATION COMPLETE /(100) / 101 04-AUG-76 (RCHM) FIX BUG IN FILE NAME VS OPTION /(101) / RECOGNITION. /(101) / 102 12-AUG-76 (RCHM) STK SHOULD IMPLY DELETE, SEEK /(102) / BEFORE ENTER IF STACKING TO /(102) / AVOID SPURIOUS FILE CREATION. /(102) / 103 25-AUG-76 (RCHM) NO STACK (NST) PARAMETER WAS /(103) / LEFT OUT OF THE ORIGIONAL /(103) / IMPLEMENTATION. ALSO THE INPUT /(103) / LUN IS NOT GETTING UPDATED IF /(103) / STACKING OCCURS. /(103) / 104 27-AUG-76 (RCHM) REJECT QUE FILE IF A $JOB CARD /(104) / DOES NOT OCCUR IN THE FILE. /(104) / 105 31-AUG-76 (RCHM) USE NUMBER SUBROUTINE TO CHECK /(105) / ACCOUNT NUMBERS INSTEAD OF KEY- /(105) / WORD SUBROUTINE. /(105) .TITLE *** MACROS FOR QUEUE PROCESSING *** .DEFIN TEXT,A,?B .NOLST B-.*400&777000 0 .ASCII "QUE -- @A"<15> B=. .LST .ENDM .DEFIN CTENT,A,B,?C .NOLST C .SIXBT "A" .IFPNZ C+2-. .IFZER C+1-. 0 .ENDC .IFZER C-. .LST .END ERROR IN TABLE ENTRY .ENDC .ENDC JMP B .LST .ENDM .TITLE *** MESSAGES FOR QUEUE PROCESSING *** MES010 TEXT <SYNTAX ERROR> MES020 TEXT <UNRECONIZABLE KEYWORD> MES030 TEXT <TRANSFER COMMAND ERROR> MES040 TEXT <CLASS PARAMETER OUT OF RANGE> MES050 TEXT <MEMORY PARAMETER OUT OF RANGE> MES060 TEXT <INCORRECT DEVICE/UNIT SPECIFICATION> MES070 TEXT <INVALID UFD SPECIFICATION> MES080 TEXT <TIME PARAMETER OUT OF RANGE> MES090 TEXT <LUN OUT OF RANGE> MES100 TEXT <STACKING DEVICE IS NOT FILE ORIENTED> MES110 TEXT <STACKING DEVICE ERROR> MES120 TEXT <INPUT FILE NOT FOUND> MES130 TEXT <INPUT DEVICE ERROR> MES140 TEXT <ERROR READING INPUT FILE> MES150 TEXT <TOO MANY JOBS QUEUED> MES160 TEXT <NO JOB CARD IN FILE> /(104) MES170 TEXT <INVALID ACCOUNT NUMBER> /(105) .TITLE *** EQUATES AND ASSEMBLY PARMS FOR QUEUE PROCESSING *** / CHARACTER EQUATES AM=175 / ALT MODE BLANK=40 / BLANK COLON=72 / COLON COMMA=54 / COMMA CR=15 / CARRIAGE RETURN EQUAL=75 / EQUAL LBKT=74 / LEFT BRACKET RBKT=76 / RIGHT BRACKET SLASH=57 / SLASH PERIOD=56 / PERIOD PERCNT=45 / PER CENT. LF=12 DOLLAR=44 JOB=121702 PAU=200125 END=051604 QUI=212522 S.=235601 / S.A FOR FILE NAME CREATION. A00=606001 / 00A FOR FILE NAME CREATION. / CONTROL EQUATES. SUPERR=400000 ALPHA=10 NUMERIC=4 PUNCT=2 RPUNCT=3 / AUTO INCREMENT EQUATES X10=10 X11=11 / INSTRUCTION EQUATES IDX=ISZ CLQ=650000 / EAE CLEAR THE MQ. ECLA=641000 / EAD CLA / LUN AND ASSEMBLY PARAMETER EQUATES .DEC TTOLUN=13 / TELETYPE OUTPUT LUN FOR TDV CASE. DEFQIN=17 / DEFAULT QUEUE INPUT LUN. DEFSTK=18 / DEFAULT QUEUE STACKING LUN. .OCT .IFUND DEFMEM DEFMEM=0 / RUN IN ANYTHING AVAILABLE. .ENDC .IFUND DEFCLS DEFCLS=0 / 0 IS THE DEFAULT JOB CLASS. .ENDC .IFUND MA.NLU MA.NLU=31 .ENDC .TITLE *** CONTROL TABLES FOR QUEUE PROCESSING *** / TABLE FOR QUE COMMAND PROCESSING. QCMD CTENT T,TIME CTENT C,CLASS CTENT M,MEMORY CTENT SEQ,SEQUEN CTENT OPR,OPERAT CTENT NCK,NOCHK CTENT DEL,DELETE CTENT HLD,HOLD CTENT STK,STACK CTENT FRC,FORCE / ALLOW THE USER TO SPECIFY "FORCE" CTENT UFD,UFDPR CTENT NST,NOSTK /(103) QCMDE=. / $JOB CARD COMMAND OPTIONS. JCMD CTENT T,TIME CTENT DEL,DELETE CTENT HLD,HOLD CTENT C,CLASS CTENT M,MEMORY CTENT SEQ,SEQUEN CTENT OPR,OPERAT CTENT FRC,FORCE / LIKEWISE FROM THE JOB CARD. CTENT UFD,UFDPR JCMDE=. .TITLE *** VARIABLES AND CPB'S FOR QUEUE PROCESSING *** QJCPB 33 / QUEJOB CPB. TEV / EVENT VARIABLE ADDRESS. FILE .BLOCK 2 / FILE NAME OF JOB INPUT FILE. IOLUN DEFQIN*1000 / INPUT AND LISTING I/O LUN NUMBERS. FLAGPT 0 / FLAGS BITS PLUS TIME IN MINUTES. CLSCOR DEFCLS*100000!DEFMEM / CLASS AND CORE DEVUN 0 / DEVICE AND UNIT (12 AND 6 BITS) UFD 0 / UFD NAME IN SIX BIT. FNAME1 0 / INPUT FILE NAME PARE 1. FNAME2 0 / INPUT FILE NAME PART 2. XFRCMD 37 / TRANSFER COMMAND CPB. TEV / EVENT VARIABLE. BUFF / BUFFER ADDRESS. 44 / BUFFER LENGTH. XRADJ 0 / XR ADJUSTMENT FUDGE FACTOR. NCKSW NOP / NO CHECK SWITCH / NOP => CHECK / SKP => NO CHECK. STKSW NOP / STACK SWITCH / SKP => STACK / NOP => NO STACK. NSTSW SKP / NO STACKING SWITCH. /(103) / SKIP => EITHER STACHING OR CHECKING /(103) / IS TO OCCUR. /(103) / NOP => NEITHER STACKING OR CHECKING /(103) / IS TO OCCUR. /(103) CLSSW 0 / CLASS ALREADY SPECIFIED SWITCH. CORESW 0 / CORE ALREADY SPECIFIED SWITCH. UFDSW NOP / UFD ALREADY SPECIFIED SWITCH. / NOP => NOT SPECIFIED. TIMESW 0 / TIME ALREADY SPECIFIED SWITCH. FNSW SKP / FILE NAME SLAREADY SPECIFIED. / SKP => NOT SPECIFIED. TEMP 0 / GENERAL TEMPORARY. JOBCRD 0 / JOB CARD COUNTER. FILE IS REJECTED /(104) / IF STACKING OCCURS AND NO JOB CARD /(104) / IS FOUND. /(104) HCPB 3600 / HINF TEV / EV ADDRESS. XX / LUN TO BE SUPPLIED DATE 24 / DATE FOR GENERATION OF STACKING FILE NAMES. 0 / NO EV ADDRESS. XX XX XX HOUR 0 / HOUR. MIN 0 / MINUTE XX READ 2600 / READ OF INPUT FILE. REV / EVENT VARIABLE ILUN DEFQIN / TO BE SUPPLIED. 2 / IOPS ASCII. BUFF / BUFFER ADDRESS. 70 / BUFFER LENGTH. REV 0 / READ EVENT VARIABLE. BUFF .BLOCK 70 / INPUT BUFFER. WFREAD 20 / WAIT FOR READ. REV / EVENT VARIABLE. WRITE 2700 / WRITE TO STACKING DEVICE. WEV / EVENT VARIABLE. DEFSTK / STACKING DEVICE. 2 / IOPS ASCII BUFF / BUFFER ADDRESS. WEV 0 / EVENT VARIABLE FOR WRITE. WFWRITE 20 / WAIT FOR WRITE. WEV / EVENT VARIABLE. / FILE PROCESSING CPB'S ATCPB 2400 / ATTACH TEV XX DTCPB 2500 / DETACH TEV XX SCPB 3200 / SEEK TEV XX XX XX .SIXBT "JOB" ECPB 3300 / ENTER TEV XX XX XX .SIXBT "JOB" CCPB 3400 / CLOSE TEV XX XX XX .SIXBT "JOB" .TITLE *** MAIN PROCESSING LOOP FOR QUEUE *** .DBREL QUEUE DZM FNAME1 / INITIALIZE SWITCHES AND THE REST DZM FNAME2 / OF THE QUEJOB CPB. DZM FLAGPT / INITIALIZE FLAGS AND DEFAULT TIME. DZM DEVUN / ZERO DEVICE AND UNIT NUMBER. DZM UFD / INITIALIZE UFD. LAC (.) / SET UP XR ADJUSTMENT CONSTANT. AND (770000) CMA!IAC DAC XRADJ / TRANSFER COMMAND TO QUEUE. CAL XFRCMD / ISSUE TRANSFER COMMAND. CAL WFTEV / WAIT FOR COMMAND TO COMPLETE. LAC TEV / CHECK FOR SUCCESSFUL COMPLETION. SMA / AC > 0 IF OK. JMP Q.0010 JMS TYPMSG / PRINT ERROR MESSAGE. MES030 / MESSAGE ADDRESS JMP SHUTDW / SHUT DOWN QUEUE. Q.0010 CLA / SCAN FOR THE FIRST TERMINATOR. Q.0015 JMS TERMSC JMP SETBIT / CR OR AM RETURN. SAD (BLANK) / TERMMINATOR A BLANK? JMP Q.0020 / YES, CONTINUE. CLA / NO, SET UP FOR CALL TO THE SCANNER. JMP Q.0025 / ENTER THE SCANNER. Q.0020 JMS FAC / FETCH THE NEXT CHARACTER AFTER THE BLANK. JMS ANP / CHECK FOR ALPHABETIC, NUMERIC OR PUNCTUATION. JMP Q.0030 / ALPHABETIC, THIS MUST BE A FILE NAME. JMP Q.0040 / NUMERIC, THIS MUST BE A LUN NUMBER. JMS TBREAK / CHECK IF THIS IS A VALID BREAK CHARACTER. SKP!CLA / IT IS, START AT THE NEXT CHARACTER FOR KEYWORDS. JMP Q.0030 / IT ISN'T THEREFORE USE IT AS A FILE NAME. Q.0025 JMS SCANNER / PERFORM COMPLETE SCANNER OF KEYWORDS. QCMD / BEGINNING OF TABLE QCMDE / END OF TABLE JMP SETBIT / GO SET UP BITS. .EJECT / PROCESSOR FOR FILE NAME DETECTION. Q.0030 XCT FNSW / WAS A FILE NAME ALREADY ENTERED? JMP Q.0025 / YES, MUST BE THE START OF THE PARAMETERS. JMS XTRACT / FETCH THE FILE NAME. ALPHA!NUMERIC!RPUNCT LAC KW1 / FETCH 1ST HALF OF KEYWORD. DAC FNAME1 / SALT IT AWAY. LAC KW2 / FETCH 2ND HALF OF KEYWORD. DAC FNAME2 / SALT IT AWAY. LAC (NOP) / FLAG THE OCCURANCE OF A FILE NAME /(101) DAC FNSW / SET UP FILE NAME SWITCH WITH NOP. /(101) LAC CHAR / FETCH THE BREAK CHARACTER. JMP Q.0015 / SCAN FOR THE NEXT TERMINATOR. / PROCESSOR FOR LUN'S Q.0040 JMS NUMBER / FETCH THE LUN NUMBER. JMP TB.ERR / SYNTAX ERROR. LAW -MA.NLU / CHECK RANGE OF LUN. TAD NUM SPA!CLA!CLL!SNA / AC > 0 IS AN ERROR. JMP Q.0045 JMS TYPMSG / PRINT ERROR MES090 JMP SHUTDW Q.0045 LACQ / FETCH LUN NUMBER. DAC ILUN / STOR IT INTO INPUT LUN. ECLA!LLSS 11 / MOVE INPUT LUN TO HIGH HALF OF MQ. LAC IOLUN / FETCH I/O LUN PAIR. AND (777) / REMOVE INPUT LUN. OMQ / INSERT NEW LUN. DAC IOLUN / STORE NEW LUN. LAC CHAR / FETCH NEXT CHARACTER. CLA / FOLLOWING THE LUN COMES ANY PARAMETERS. JMP Q.0025 .TITLE *** QUE COMMAND PROCESSING COMPLETE *** SETBIT LAC FNAME1 / MOVE FILENAME SPECIFIED IN COMMAND IN CASE NO DAC FILE / STACKING IS REQUIRED. LAC FNAME2 DAC FILE+1 XCT NSTSW / STACKING AND CHECKING SUPPRESSED? /(103) JMP STKDON / YES. /(103) LAC ILUN / FETCH INPUT DEVICE LUN NUMBER. JMS HINF / GET HANDLER INFORMATION. DAC TEMP / SAVE HINF FROM INPUT DEVICE. LAC (DEFSTK) / HINF STACKING DEVICE. JMS HINF XOR TEMP / CHECK HINF OF NEW DEVICE AGAINS AND (37777) / INPUT DEVICE. SNA / SAME? JMP SE.010 / YES. LAC (SKP) / NO, FORCE DAC STKSW / STACKING. LAC (400000) / IMPLY DELETE IF STACKING. /(102) LMQ / LOAD THE MQ. /(102) LAC FLAGPT / FETCH THE FLAG BITS. /(102) OMQ / OR IN THE DELETE BIT. /(102) DAC FLAGPT / RESTORE THE NEW SWITCH SETTINGS. /(102) SE.010 XCT STKSW / IS STACKING REQUIRED? JMP SE.080 / NO, SEE IF CHECKING IS DESIRED. LAC IOLUN / FETCH I/O PARAMETERS FROM QUEJOB /(103) / CPB. /(103) AND (777) / CLEAR INPUT LUN SPECIFICATION. /(103) XOR (DEFSTK*1000) / SET THE STACKING DEVICE FOR INPUT /(103) DAC IOLUN / AND RESTORE THE NEW INPUT LUN VALUE. /(103) LAC (DEFSTK) / CHECK THE CHARACTERISTICS JMS HINF / OF THE STACKING DEVICE. AND (40000) SZA / FILE ORIENTED? JMP SE.020 / YES, CONTINUE. JMS TYPMSG / NO, ERROR. MES100 / NOT FILE ORIENTED. JMP SHUTDW / SHUT DOWN QUEUE PROCESSING. SE.020 CAL DATE / CONSTRUCT A STACKING FILE NAME. LAC HOUR / HOUR MAPS TO A LETTER BEGINNING WITH "A" TAD (S.) DAC FILE / STACKING FILE NAME, FIRST HALF. LAC MIN / FETCH MINUTES. CLQ!LRSS 3 / SEPERATE HIGH AND LOW SECONDS. ALSS 3 / SET UP SPACING FOR CONVERSION TO CHARACTERS. LLSS 11 / MOVE 0X0X00 INTO AC. XOR (A00) / CONVERT TO 6X6X01 DAC FILE+1 / SECOND HALF OF STACKING FILE NAME. LAC (DEFSTK) / ATTACH THE STACKING DEVICE. JMS ATTACH SE.030 LAC (DEFSTK) / SEEK THE CONSTRUCTED FILE. JMS SEEK FILE-1 SPA / FILE FOUND? JMP SE.040 / NO, CONTINUE. LAC (DEFSTK) / CLOSE THE LOCATED FILE AND TRY AGAIN. JMS CLOSE FILE-1 ISZ FILE+1 / CONSTRUCT NEW FILE NAME. SMA / CLOSE OK? JMP SE.030 / YES, TRY NEW FILE NAME. JMP BADSTK / NO, STACKING DEVICE ERROR. SE.040 SAD (-13) / FILE NOT FOUND? SKP / YES, OK. JMP BADSTK / NO, STACKING DEVICE ERROR. SE.050 LAC ILUN / SET UP INPUT DEVICE. THE CODE MAY BE ENTERED AT / THIS POINT IF CHECKING BUT NOT STACKING IS SPECIFIED. JMS ATTACH SMA / DID THE ATTACH MAK IT OK? JMP SE.060 / YES. SAD (-6) / ILLEGAL FUNCTION? SKP / YES. JMP BADINP / INPUT DEVICE ERROR. SE.060 LAC ILUN / CHECK THE CHARACTERISTICS OF THE INPUT DEVICE. JMS HINF AND (40000) SNA / FILE ORIENTED? JMP SE.065 / NO, THE ATTACH WAS ENOUGH. /(102) LAC ILUN / FIND THE INPUT FILE. JMS SEEK FNAME1-1 SMA / DID THE FILE GET OPENED? JMP SE.065 / YES, CONTINUE. /(102) SAD (-13) / FILE NOT FOUND? JMP FILENF / YES. JMP BADINP / NO, INPUT DEVICE ERROR. SE.065 XCT STKSW / STACKING DESIRED? /(102) JMP SE.070 / NO, BYPASS ENTER. /(102) LAC (DEFSTK) / ENTER STACKING DEVICE FILE NAME. /(102) JMS ENTER /(102) FILE-1 /(102) SPA / ENTER MADE IT OK? /(102) JMP BADSTK / NO, STACKING DEVICE ERROR. /(102) SE.070 CAL READ / READ A LINE FROM THE INPUT DEVICE. CAL WFREAD / WAIT FOR THE READ. LAC REV / READ SUCCESSFUL? SPA JMP RERR / NO, READ ERROR. LAC BUFF / CHECK FOR END OF FILE AND (7) SAD (5) JMP STKDON / ALL DONE ON END OF FILE. XCT STKSW / STACKING IN PROGRESS? JMP SE.075 / NO. CAL WRITE / WRITE TO OUTPUT FILE. CAL WFWRITE / WAIT FOR WRITE. LAC WEV / CHECK EV. SPA / EV OK? JMP BADSTK / NO, STACKING DEVICE ERROR. SE.075 XCT NCKSW / CHECKING TO BE DONE? JMS CHECK / YES, CHECK FOR $XXXXX CONXTRUCT. JMP SE.070 SE.080 XCT NCKSW / CHECKING INVOKED? JMP SE.050 / YES, CONTINUE. STKDON LAC ILUN / DETACH INPUT DEVICE. JMS DETACH LAC (DEFSTK) / DETACH OUTPUT DEVICE. JMS DETACH /(104) / CHECK TO SEE IF A JOB CARD WAS FOUND. /(104) /(104) XCT NSTSW / STACKING AND CHECKING SUPPRESSED? /(104) JMP STKD.1 / YES. /(104) XCT NCKSW / CHECKING ACTIVATED? /(104) SKP / YES, CHECK FOR JOB CARD. /(104) JMP STKD.1 / NO, NO JOB WOULD BE FOUND. /(104) LAC JOBCRD / ANY JOB CARDS FOUND? /(104) SZA /(104) JMP STKD.1 / YES. /(104) JMS TYPMSG / PRINT ERROR MESSAGE. /(104) MES160 /(104) XCT STKSW / STACKING IN EFFECT? /(104) JMP SHUTDW / NO. /(104) LAC (DEFSTK) / RE ATTACH THE STACKING DEVICE. /(104) JMS ATTACH /(104) LAC (3500) / DELETE STACKING FILE. /(104) DAC ECPB / GET FILE NAME FROM ENTER. /(104) CAL ECPB / DELETE FILE NAME. /(104) CAL WFTEV / WAIT FOR DELETE TO COMPLETE. /(104) JMP SHUTDW / SHUT DOWN. /(104) STKD.1 CAL QJCPB / QUE CONSTRUCTED CPB TO BATCH. /(104) CAL WFTEV / WAIT FOR QUE TO COMPLETE. LAC TEV / WAS THE QUE SUCCESSFUE? SMA JMP ST.010 / YES, CONTINUE. JMS TYPMSG / NO. MES150 JMP SHUTDW ST.010 JMS DECPRT / PRINT JOB ID TO THE USER. SHUTDW CAL (10) / ALL DONE. .TITLE *** STACKING AND CHECKING ERROR EXITS *** BADSTK JMS TYPMSG MES110 JMP SHUTDW FILENF JMS TYPMSG MES120 JMP SHUTDW BADINP JMS TYPMSG MES130 JMP SHUTDW RERR JMS TYPMSG / NO, INPUT FILE WASN'T IOPS ASCII. MES140 JMP SHUTDW / SHUT DOWN QUEUE PROCESSING. .TITLE *** FILE PROCESSING SUBROUTINES *** HINF XX DAC HCPB+2 CAL HCPB CAL WFTEV LAC TEV JMP* HINF ATTACH XX DAC ATCPB+2 CAL ATCPB CAL WFTEV LAC TEV JMP* ATTACH SEEK XX DAC SCPB+2 LAC* SEEK ISZ SEEK JMS MOVEF SCPB+2 CAL SCPB CAL WFTEV LAC TEV JMP* SEEK MOVEF XX DAC* (X10) LAC* MOVEF DAC* (X11) ISZ MOVEF LAC* X10 DAC* X11 LAC* X10 DAC* X11 JMP* MOVEF CLOSE XX DAC CCPB+2 LAC* CLOSE ISZ CLOSE JMS MOVEF CCPB+2 CAL CCPB CAL WFTEV LAC TEV JMP* CLOSE ENTER XX DAC ECPB+2 LAC* ENTER ISZ ENTER JMS MOVEF ECPB+2 CAL ECPB CAL WFTEV LAC TEV JMP* ENTER DETACH XX DAC DTCPB+2 CAL DTCPB CAL WFTEV LAC TEV JMP* DETACH .TITLE *** CARD CHECKING SUBROUTINE *** CHECK XX / ENTRY POINT. LAC (BUFF+2) / RESET CONTROL POINTERS AND FLAGS FOR SYNTAX DAC FACLBX / ANALYSIS. LAC (FACCB+5) DAC FACCBX LAC (BLANK) DAC PBREAK CH.010 JMS FAC / FETCH THE FIRST CHARACTER. SAD (LF) / IS IT A LINE FEED? JMP CH.010 / IGNORE ALL INITIAL LINE FEEDS. SAD (DOLLAR) / IS IT A $ SIGN? SKP!CLA / YES, CONTINUE. JMP* CHECK / NO, LEAVE CHECKING. JMS XTRACT / FETCH KEYWORD. SUPERR!ALPHA!NUMERIC LAC CHAR / ADVANCE THE POINTER TO THE NEXT BREAK CHARACTER JMS TERMSC / IF NOT ALREADY AT ONE. NOP / IGNORE CR/AM RETURNS. LAC KW1 / FETCH FIRST HALF OF NAME. SAD (JOB) / FIRST 3 CHARACTERS = JOB? SKP / YES, CONTINUE JMP PAUSE / NO, CHECK FOR PAUSE. ISZ JOBCRD / INCREMENT JOB CARD COUNTE. /(104) CH.020 JMS FAC / GET CHE NEXT CHARACTER (THERE MUST BE ONE) SAD (BLANK) / BLANK? JMP CH.020 / YES. JMS ANP / CHECK CHARACTER TYPE. JMP TB.ERR / ALPHA IS AN ERROR. SKP / NUMERIC IS GOOD. JMP TB.ERR / PUNCTUATION IS AN ERROR. JMS NUMBER / EXTRACT THE ACCOUNT NUMBER. /(105) JMP CH.040 / INVALID NUMBER SPECIFIED. /(105) LAC CHAR / GET THE LAST CHARACTER. SAD (BLANK) / BLANK? JMP CH.030 / YES, THIS CARD HAS KEYWORDS. JMS TERM / IS IT A TERMINATOR? JMP TB.ERR / NO, ERROR. JMP* CHECK / YES, ALL DONE WITH THE CARD. CH.030 CLA / START KEYWORDS WITH THE NEXT CHARACTER. JMS SCANNER JCMD JCMDE JMP* CHECK /(105) CH.040 JMS TYPMSG / PRINT ERROR MESSAGE. /(105) MES170 / INVALID ACCOUNT NUMBER. /(105) JMP SHUTDW / KILL PROCESSING. /(105) PAUSE SAD (PAU) / CHECK FOR "PAU" SKP / YEP, TRY NEXT SET OF CHARACTERS. JMP ENDQUI LAC (577777) AND FLAGPT XOR (200000) / SET THE OPERATOR INTERVENTION BIT REQUIERD. DAC FLAGPT JMP* CHECK / ALL DONE. ENDQUI SAD (END) / CHECK FOR $END. JMP STKDON / ALL DONE. SAD (QUI) / CHECK FOR $QUIT) JMP STKDON JMP* CHECK / NONE OF THE ABOVE, RETURN. .TITLE *** $JOB CARD AND QUE COMMAND OPTION PROCESSING *** / ALL THE VARIOUS FLAG OPTIONS. HOLD RAR / KEY WORD SCANNER WILL ALWAYS LEAVE THE LINK / SET FOR THESE "ROUTINES". RAR SEQUEN RAR / SEQ FLAG. FORCE RAR / FRC FLAG. OPERAT RAR / OPERATOR INTERVENTION REQUIRED FLAG. DELETE RAR / DELETE AFTER USEING FLAG. LMQ / SET UP FOR INCLUSIVE OR. LAC FLAGPT / FETCH FLAGS WORD. OMQ / OR IN THESE FLAG BITS. DAC FLAGPT / KEEP NEW BIT SETTINGS. JMP SC.090 / GO GET THE NEXT KEYWORD. / MISCELLANEOUS CONTROL SWITCH SETUP ROUTINES. STACK XCT NSTSW / STACKING PROHIBITTED? /(103) JMP SC.090 / YES, AVOID SETTING DEL BIT. /(103) LAC (SKP) / SET UP STACKING. /(103) DAC STKSW CLA!STL / SET THE DELETE BIT IN THE PARAMETER /(102) JMP DELETE / BIT OF THE QUEJOB CPB. /(102) NOSTK LAC (NOP) / SET UP THE NO STACKING SWITCH. /(103) DAC NSTSW /(103) LAC FLAGPT / CLEAR THE DELETE SWITCH. /(103) AND (377777) / JUST IN CASE. /(103) DAC FLAGPT /(103) JMP SC.090 / RETURN TO THE SCANNER. /(103) NOCHK LAC (SKP) / TURN OFF CHECKING. DAC NCKSW JMP SC.090 / VARIOUS OTHER PARAMETERS. FOR NUMERIC PARAMETERS (M=,C=) USE THE HIGHEST / VALUE OF THE PARAMETER ENCOUNTERED IN THE PROCESSING. CLASS CLA / WE SHOULD BE AT A BREAK CHARACTER. FETCH THE JMS NUMBER / WHOLE NUMBER. JMP TB.ERR / SYNTAX ERROR. LAW -10 / CLASS SHOULDN'T BE BIGGET THAN 7. TAD NUM SPA!CLL!CLA JMP CL.010 / NO ERROR JMS TYPMSG / ERROR MESSAGE "CLASS VALUE OUT OF RANGE" MES040 JMP SHUTDW / SHUT DOWN QUEUE. CL.010 LAC CLSSW / FETCH CLASS SWITCH. SZA / CLASS ALREADY SPECIFIED? JMP SC.090 / YES, ALL DONE. LLS 17 / SHIFT NEW CLASS INTO PROPER BITS OF THE MQ. LAC CLSCOR / FETCH CLASS AND CORE. AND (77777) / STRIP OFF DEFAULT CLASS BITS. OMQ / INSERT NEW CLASS BITS. ISZ CLSSW / INDICATE THAT CLASS HAS BEEN SPECIFIED. DAC CLSCOR / RESTORE NEW CLAS PARAMETER. JMP SC.090 / ALL DONE. MEMORY CLA / SHOULD BE AT A BREAK CHARACTER SO, JMS NUMBER / FETCH THE ENTIRE NUMBER. JMP TB.ERR / SYNTAX ERROR. LAW -200 / CHECK FOR RANGE. TAD NUM / MUST BE <= 128 K. SPA!SNA / AC > 0 => ERROR. JMP ME.010 / GOOD MEMORY PARAMETER. JMS TYPMSG / ERROR MESSAGE. MES050 / "MEMORY PARAMETER OUT OF RANGE" JMP SHUTDW / SHUT DOWN QUEUE. ME.010 LAC CORESW / FETCH CORE SPECIFIED SWITCH. SZA / CORE ALREADY SPECIFIED? JMP SC.090 / YES. LAC NUM / FETCH AMOUNT OF CORE. SZA / ALREADY ZERO? AAC -1 / NO, DECREMENT PROPERLY FOR 128K CASE. LMQ / STUF IT INTO THE MQ. LAW -177 / FETCH AND MASK. AND CLSCOR / REMOVE OLD CORE SPECIFICATION. OMQ / OR IN THE MQ. DAC CLSCOR / STORE THE NEW VALUE. ISZ CORESW / BELT OUT THE CORE SWITCH. JMP SC.090 / ALL DONE. TIME CLA / EXTRACT NUMBER. JMS NUMBER JMP TB.ERR / SYNTAX ERROR. LAW -2000 / 1023 MINUTES MAXIMUM. TAD NUM / CHECK FOR IT. SPA / ERROR? JMP TI.010 / NO, CONTINUE. JMS TYPMSG / ERROR MESSAGE. MES080 JMP SHUTDW TI.010 LAC TIMESW / TIME ALREADY SPECIFIED? SZA JMP SC.090 / NO. ISZ TIMESW / FLAG TIME SWITCH. LAW -1777 AND FLAGPT / REMOVE TIME BITS. OMQ / SET TIME BITS. DAC FLAGPT / STORE NEW TIME LIMIT. JMP SC.090 / FETCH NEXT KEYWORD. / UFD PROCESSING. / / PARAMETER IS OF THE FORM UFD=DDNN<UFD> / [DD[NN]][<UFD>] UFDPR CLA / NO PREVIOUS CHARACTERS. JMS XTRACT / FETCH THE DEVICE NAME. ALPHA / CONTROL ALPHA ONLY. LAC KWL / FETCH LENGTH OF DEVICE. SNA / DEVICE SUPPLIED? JMP UF.020 / NO. AAC -2 / IT BETTER BE 2. SZA / OK? JMP UF.ER1 / NOT OK. LAC KW1 / FETCH DEVICE NAME, RIGHT ADJUSTED. DAC TEMP / SAVE IN TEMP LOCATION. LAC CHAR / FETCH THE LAST CHARACTER THROUGH XTRACT. CLQ / JUST IN CASE OF "DD<" SAD (LBKT) / ANY UNIT NUMBER SPECIFIED? JMP UF.010 / NO, BY PASS NUMBER EXTRACTION. JMS NUMBER JMP UF.ER1 / BAD UNIT NUMBER. LAW -100 TAD NUM SMA / AC >= 0 IF BAD UNIT NUMBER. JMP UF.ER1 / UNIT NUMBER OUT OF RANGE. UF.010 LAC TEMP / FETCH DEVICE. OMQ / ADD IN DEVICE NUMBER. XCT UFDSW / SHOULD WE ALTER THE CONTENTS? DAC DEVUN / YES. UF.020 LAC PBREAK / FETCH THE LAST BREAK CHARACTER. SAD (LBKT) / CHECK FOR LEFT BRACKED. SKP!CLA / YEP, GET UFD NAME. JMP UF.040 / NO, SET UP ALREADY SPECIFIED SWITCH. JMS XTRACT / GET KEYWORD. ALPHA!NUMERIC / CONTROL ALPHA AND NUMERIC, NO PUNCT. LAC KWL / CHECK LENGTH. AAC -3 / IT HAD BETTER BE THREE. SZA / AC = 0 IF YES. JMP UF.ER2 LAC KW1 / FETCH THREE CHARACTER UFD. XCT UFDSW DAC UFD / STORE NEW UFD. UF.040 LAC (SKP) / FLAG ALREADY SPECIFIED. DAC UFDSW LAW 15777 / SET UFD BIT IN QUEJOB CPB. AND FLAGPT XOR (2000) DAC FLAGPT JMP SC.090 / ALL DONE. UF.ER1 JMS TYPMSG / PRINT ERMESSAGE. MES060 JMP SHUTDW UF.ER2 JMS TYPMSG MES070 JMS SHUTDW .TITLE *** EXTRACT KEYWORDS SEPERATED BY TERMINATORS *** / / CALLING SEQUENCE: / / [CLA OR LAC CHAR] / JMS XTRACT / CONTROL MASK / NORMAL RETURN / / EXTRACT WILL AUTOMATICALLY TAKE AN ERROR EXIT IF THE / KEYWORD IS TOO LONG TO BE RECOGNIZED. / XTRACT XX / ENTRY POINT. DAC CHAR / SAVE POSSIBLE CHARACTER UPON ENTRY. LAC* XTRACT / FETCH CONTROL MASK. DAC XMASK / SAVE CONTROL MASK. ISZ XTRACT / POINT TO CORRECT RETURN ADDRESS. DZM KWL / INITIALIZE LENGTH OF EXTRACTED KEYWORDS. DZM KW1 / INITIALIZE KEYWORD BUFFER. DZM KW2 / LAW -7 / INITIALIZE ERROR INDICATOR FOR TOO LONG DAC KW.MAX / A KEYWORD. LAW -3 / NUMBER OF CHARACTERS PER WORD. DAC KW.WDL LAC (KW1) / INITIALIZE POINTER TO OUTPUT BUFFER. DAC KW.PTR / LAC CHAR / FETCH AC FROM ENTRY. SNA / SHOULD WE EXTRACT THE NEXT CHARACTER? XT.010 JMS FAC / YES. DAC CHAR / SAV THE CHARACTER. JMS TBREAK / IS THIS CHARACTER A BREAK? JMP* XTRACT / YES, RETURN. JMS ANP / CHECK FOR SECONDARY BREAK. JMP XT.030 / ALPHABETIC JMP XT.040 / NUMERIC JMP XT.050 / PUNCTUATION. XT.015 LAC CHAR / RESTORE THE CHARACTER. ISZ KWL / COUNT CHARACTER. ISZ KW.MAX / ERROR? JMP XT.020 / NO. LAC XMASK / GENERATE THE ERROR SPA JMP* XTRACT / NO. XT.017 JMS TYPMSG / PRINT ERROR MESSAGE. MES020 / MESSAGE ADDRESS. JMP SHUTDW / SHUT DOWN QUE PROCESSING. XT.020 AND (77) / CONVERT CHARACTER TO 6 BIT. DAC CHAR / SAVE IT FOR LATER. LAC KW.WDL / FETCH NUMBER OF CHARACTERS REMAINING / IN THE WORD. CMA / SET UP SHIFT INSTRUCTION. MUL; 6 / CALCULATE NUMBER OF BITS TO SHIFT. LACQ / FETCH NUMBER OF BITS TO SHIFT. TAD (ALSS 0) / CALCULATE SHIFT INSTRUCTION. DAC .+2 / SET UP INLINE INSTRUCTION TO SHIFT. LAC CHAR / THE CHARACTER FOR THE 6 BIT WORD. XX / IMPURE INSTRUCTION, ALSS N. XOR* KW.PTR / SET UP NEW 6 BIT CHARACTER. DAC* KW.PTR / SAVE NEW 6 BIT CHARACTER. ISZ KW.WDL / OUT OF ROOM IN THE CURRENT WORD? JMP XT.010 / NO, FETCH THE NEXT CHARACTER. ISZ KW.PTR / POINT TO NEXT WORD OF BUFFER. LAW -3 / RE INIT THE CHARACTER COUNTER. DAC KW.WDL JMP XT.010 / FETCH THE NEXT CHARACTER. / VARIABLES FOR 6 BIT EXTRACT. KWL 0 / LENGTH OF KEYWORD EXTRACTED. KW1 0 / KEYWORD BUFFER. FOR THIS APPLICATION IT KW2 0 / WILL ONLY BE 2 WORDS LONG. KW.PTR 0 / POINTER TO 6 BIT BUFFER. KW.WDL 0 / NUMBER OF CHARACTERS PER WORD. KW.MAX 0 / NUMBER OF CHARACTERS MAX PER KEYWORD. XMASK 0 / CONTROL MASK. / CHECKS FOR CONTROL MASK. XT.030 LAC XMASK / CHECK FOR ALPHA ALLOWED. AND (10) / EXTRACT ALPHA BIT. XT.035 SZA / ALPHA ALLOWED? JMP XT.015 / YES, CONTINUE. JMP* XTRACT / NO, RETURN. XT.040 LAC XMASK / CHECK FOR NUMERIC ALLOWED. AND (4) / EXTRACT NUMERIC BIT. JMP XT.035 XT.050 LAC XMASK / CHECK FOR PUNCTUATION/RESTRICTED PUNCTUATION. RTR / MOVE RP INTO SIGN, P INTO LINK. SNL / PUNCTUATION ALLOWED? JMP* XTRACT / NO. SMA / RESTRUCTED PUNCTUATION? LAC CHAR / FETCH THE CHARACTER. JMP XT.015 / NO, CONTINUE. SAD (PERIOD) / ALLOW A PERIOD. JMP XT.015 / CONTINUE. SAD (PERCNT) / ALLOW %. JMP XT.015 JMP* XTRACT / ALL DONE. .TITLE *** KEYWORD SCANNER *** / / CALLING SEQUENCE: / / [CLA OR LAC CHAR] / JMS SCANNER / CTLADDR / ADDRESS OF THE CONTROL TABLE. / CTLEND / ADDRESS OF THE END OF THE CONTROL TABLE. / / UPON EXIT ALL FLAGS WILL BE SET. THE SCANNING ROUTINE / ASSUMES THAT ALL PREPROCESSING HAS BEEN ACCOMPLISHED AND / THE NEXT THING TO DO WILL BE SCANNING FOR KEYWORDS. / SCANNER XX / ENTRY POINT. DAC CHAR / SAVE CHARACTER JUST IN CASE. LAC* SCANNER / FETCH CONTROL TABLE ADDRESS. DAC CTLTBL / SET UP KEYWORD SCANNING TABLE ADDRESS. ISZ SCANNER / MOVE TO CORRECT RETURN ADDRESS. LAC* SCANNER / FETCH END OF CONTROL TABLE. DAC CTLEND / SET UP END OF CONTROL TABLE. ISZ SCANNER / SET UP CORRECT RETURN ADDRESS. LAC CHAR / FETCH AC STATE UPON ENTRY. SC.020 JMS XTRACT / FETCH A KEYWORD. ALPHA / CONTROL WORD. ALPHA ONLY. LAC KWL / CHECK LENGTH OF THE KEYWORD. SZA / WAS IT ZERO? JMP SC.010 / NO, CONTINUE. LAC PBREAK / WAS THE PREVIOUS BREAK CHARACTER A CR? SAD (CR) JMP* SCANNER / YES, RETURN. JMP SC.090 / ADVANCE TO THE NEXT CHARACTER. SC.010 JMS KWCMP / CHECK THE SUPPLIED LIST OF KEYWORDS. CTLEND XX / SUPPLIED ADDRESS OF KEYWORD TABLE END. CTLTBL XX / SUPPLIED ADDRESS OF KEYWORD TABLE. SC.090 CLA / SET UP FOR THE NEXT CALL TO XTRACT. JMP SC.020 / GET THE NEXT KEYWORD. .EJECT / SCAN THE CONTROL TABLE FOR A MATCH WITH THE KEYWORD SPECIFIED IN / KW1 AND KW2. KWCMP XX / ENTRY POINT. LAC* KWCMP / FETCH CONTROL TABLE END. JMS SETXR / CALCULATE FUDGE VERSION OF THE ADDRESS. PXL / SHOVE IT IN THE LR. ISZ KWCMP / GET THE NEXT PARAMETER. LAC* KWCMP / FETCH THE START OF THE CONTROL TABLE. JMS SETXR / INDICATE THE BEGINNING OF THE CONTROL TABLE. ISZ KWCMP / POINT TO THE RETURN ADDRESS. KW.010 LAC KW1 / CHECK FIRST HALF OF THE KEYWORD. SAD 0,X / SAME? SKP / YES. JMP KW.020 / NO. LAC KW2 / FETCH NEXT HALF. SAD 1,X / SAME? SKP!CLA!STL / YES, DEFAULT STATE OF LINK AND AC FOR SWITCHES. SKP / NO. JMP 2,X / DISPATCH TO FUNCTION. KW.020 AXS 3 / GO TO NEXT TABLE ENTRY. JMP KW.010 / NOT DONE WITH TABLE YET. JMP XT.017 / UNRECOGNIZABLE KEYWORD. .TITLE *** CHECK FOR BREAK CHARACTER *** / / NOTE: ABOUT 2/3 OF THE ERROR CHECKING DONE IN QUE IS DONE / RIGHT HERE. IT IS DONE BY ANALYSING THE ORDER IN WHICH / TERMINATOR CHARACTERS APPEAR IN THE QUE AND $JOB COMMAND / STRUCTURE. ALL ERROR EXITS ARE TAKEN AUTOMATICALLY. / / CALLING SEQUENCE: / / LAC CHAR / JMS TBREAK / BREAK CHARACTER RETURN. / NON-BREAK CHARACTER RETURN. / TBREAK XX / ENTRY POINT. DAC TB.CHR / SAVE THE CHARACTER. / CHECK FOR BREAK CHARACTER. SAD (CR) / CARRIAGE RETURN? JMP TB.010 / YES. SAD (AM) / OR CR EQUAVILENT? JMP TB.010 / YES. / CHECK FOR BLANK OR BLANK EQUIVALENT. SAD (BLANK) JMP TB.020 SAD (COMMA) JMP TB.020 SAD (SLASH) JMP TB.020 / CHECK FOR EQUALS OR EQUAL EQUIVALENTS. SAD (EQUAL) JMP TB.030 SAD (COLON) JMP TB.030 / CHECK FOR LEFT BRACKET. SAD (LBKT) JMP TB.040 / CHEDK FOR RIGHT BRACKET. SAD (RBKT) JMP TB.050 / CHARACTER IS NOT A BREAK CHARACTER. ISZ TBREAK JMP* TBREAK / CR EQUIVALENTS. TB.010 LAC (CR) DAC TB.CHR TB.015 LAC PBREAK / WHAT WAS THE PREVIOUS BREAK CHARACTER. SAD (LBKT) / LEFT BRACKET? JMP TB.ERR / YES, SYNTAX ERROR. TB.BRK LAC TB.CHR / FETCH NEW BREAK CHARACTER. DAC PBREAK / MAKE IT THE PREVIOUS BREAK CHARACTER. JMP* TBREAK / TAKE BREAK CHARACTER RETURN. / BLANK EQUIVALENTS. TB.020 LAC (BLANK) / MAKE ALL CHARACTERS BLANK IN THE EYES OF / THE SCANNER. DAC TB.CHR JMP TB.015 / SAME RULES APPLY TO BLANK AS DO TO CR. / EQUAL EQUIVALENTS. TB.030 LAC (EQUAL) / MAP TO EQUAL. DAC TB.CHR LAC PBREAK / FETCH PREVIOUS BREAK CHARACTER. SAD (LBKT) / LEFT BRACKET? JMP TB.ERR / YES, ERROR. SAD (RBKT) / RKGHT BRACKET? JMP TB.ERR / YES, ERROR. SAD (EQUAL) / EQUAL SIGN? JMP TB.ERR / YES, ERROR. JMP TB.BRK / ALL OTHER BREAK CHARACTERS ARE OK. / LEFT BRACKET. TB.040 LAC PBREAK SAD (EQUAL) / EQUAL SIGN? JMP TB.BRK / YES, OK. JMP TB.ERR / ALL OTHER BREAK CHARACTERS ARE AN ERROR. / RIGHT BRACKET. TB.050 LAC PBREAK SAD (LBKT) / RIGHT BRACKET? JMP TB.BRK / YES, OK. JMP TB.ERR / ALL OTHER BREAK CHARACTERS ARE AN ERROR. / ERROR EXIT FOR BREAK CHARACTER PROCESSING. TB.ERR JMS TYPMSG / PRINT ERROR MESSAGE. MES010 / MESSAGE ADDRESS. JMP SHUTDW / KILL QUE. / VARIABLES AND STORAGE FOR BREAK CHARACTER PROCESSING. TB.CHR 0 / TEMPORARY STORAGE FOR BREAK CHARACTER / AND IT'S EQUAVILENTS. PBREAK 0 / PREVIOUS BREAK CHARACTER FOR DETERMINING / PRECEDENCE ERRORS. .TITLE *** TYPE ERROR MESSAGE ROUTINE *** / / CALLING SEQUENCE: / / JMS TYPMSG / MSGADR / MESSAGE ADDRESS. / RETURN POINT. / TYPMSG XX / ENTRY POINT. LAC* TYPMSG / FETCH MESSAGE ADDRESS. DAC MSGADR / SET UP ADDRESS IN CPB. ISZ TYPMSG / SET UP RETURN ADDRESS. CAL TYPIT / PRINT MESSAGE. CAL WFTEV / WAIT FOR MESSAGE TO COMPLETE. JMP* TYPMSG / ALL DONE, RETURN. / VARIABLES AND STORAGE FOR TYPMSG. TYPIT 2700 / WRITE CPB. TEV / EVENT VARIABLE ADDRESS. TTOLUN / TELETYPE OUTPUT LUN. 2 / MODE (IOPS ASCII) MSGADR XX / MESSAGE ADDRESS. TEV 0 / EVENT VARIABLE. WFTEV 20 / WAIT FOR TEV TO SUCCEED. TEV .TITLE *** OTHER CHARACTER PROCESSING ROUTINE STORAGE *** SAVAC 0 / FOR NUMBER NUM 0 NUMT 0 CHAR 0 .TITLE *** MISCELLANEOUS SUBROUTINES *** TERM XX / CHECK FOR CR OR AM AND SKIP IF YES. SAD (15) / CARRIAGE RETURN? SKP / YES. SAD (175) / ALT MODE? ISZ TERM / YES. JMP* TERM / RETURN. BLSCAN XX / SCAN FOR FIRST BLANK. BL.010 JMS FAC / FETCH A CHARACTER. JMS TERM / IS IT A TERMINATOR? SKP / NO. JMP* BLSCAN / YES, TAKE FUNNY RETURN. SAD (BLANK) / BLANK? SKP / YES. JMP BL.010 / NO. ISZ BLSCAN / SET UP FOR RETURN. JMP* BLSCAN / RETURN. / SET XR ROUTINE. SETXR XX /ENTRY POINT. TAD XRADJ / FUDGE ADDRESS. PAX / SHOVE VALUE IN XR. JMP* SETXR .TITLE *** STRING HANDLING PRIMITIVES *** / / FAC -- SUBROUTINE TO FETCH A CHARACTER FROM 5/7 ASCII LINE BUFFER 'FACLB'. / CHARACTERS ARE NOT FETCHED BEYOND TERMINAL CHARACTERS / FAC 0 LAC* FACCBX /FETCH NEXT UNPACKED CHARACTER FROM 'FACCB' SMA /WAS CHARACTER BUFFER (FACCB) EMPTY? JMP FAC2 /NO -- TEST FOR TERMINAL CHARACTER LAC (FACCB-1) /YES -- REFIL 'FACCB' DAC FACCBX LAC* FACLBX /(FIRST HALF OF WORD PAIR) ISZ FACLBX LMQ CLA!CLL JMS FACUPS /(FIRST CHAR) JMS FACUPS /(SECOND CHARACTER JMS FACUPS /(FIRST FOUR BITS OF THIRD CHARACTER) LAC* FACLBX /(SECOND HALF OF WORD PAIR) ISZ FACLBX LRS 17 /(LAST THREE BITS OF THIRD CHAR) XOR* FACCBX DAC* FACCBX CLA JMS FACUPS /(FORTH CHAR) JMS FACUPS /(FIFTH CHAR) LAC (FACCB) /RESET CHAR BUF INDEX DAC FACCBX LAC* FACCBX /FETCH FIRST CHAR FROM BUFFER FAC2 SAD (015) /IF TERMINAL CHARACTER, (CR OR AM) JMP* FAC /RETURN WITH CHAR IN AC BUT DO NOT SAD (175) /AUGMENT CHAR BUF INDEX (REPEATED CHAR) JMP* FAC /OF FAC WILL RETURN THE TERMINAL CHARACTER) / ISZ FACCBX /NON-TERMINAL CHARACTER -- AUGMENT CHARACTER JMP* FAC /BUFFER INDEX AND RETURN WITH CHAR IN AC / FACUPS 0 /UNPACKING SUBROUTINE -- AC & LINK MUST BE LLS 7 /CLEARED, NEXT CHAR MUST BE IN HIGH ORDER ISZ FACCBX /MQ, 'FACCBX' MUST POINT TO WORD PRECEEDING DAC* FACCBX /CHAR TO BE STORED. CLA /CHAR IS SHIFTED INTO AC (LOW ORDER BITS JMP* FACUPS /OF THIRD CHAR ARE ZERO BECAUSE LINK IS /ZERO), STORED, 'FACCBX' IS LEFT POINTING TO /CHAR, AND AC IS CLEARED (LINK IS ALSO LEFT CLEARED FACLBX BUFF+2 /LINE BUFFER INDEX FACCBX FACCB+5 /CHARACTER BUFFER INDEX FACCB .BLOCK 5 /CHARACTER BUFFER (5 IMAGE ALPHA CHARS) -1 /END OF 'FACCB' INDICATOR .EJECT / / SUBROUTINE NUMBER -- READ A DECIMAL NUMBER OF UP TO 3 DIGITS / OFF THE MCR TTY. / / ALTERED REGISTERS: AC AND MQ / / CALLING SEQUENCE: / CLA /CLA IF 1ST CHAR NOT IN AC / JMS NUMBER / JMP ??? /RETURN HERE IF 1ST CHARACTER / /AFTER A BUNCH OF SPACES IS NOT / /A DECIMAL DIGIT WITH THE CHARACTER / /IN THE AC. / ??? ??? /RETURN HERE IF 1ST CHARACTER / /AFTER A BUNCH OF SPACES IS A DECIMAL / /DIGIT WITH THE BREAK CHARACTER IN THE / /AC AND THE NUMBER IN THE MQ. / NUMBER 0 DZM NUM /ZERO PREVIOUS RESULTS SNA NUM1 JMS FAC /GET A CHARACTER JMS ANP / CHECK FOR ALPHA, NUMERIC, OR PUNCT. / ANP PUTS CHARACTER IN "CHAR" JMP NUMERR / ALPHA IS AN ERROR. JMP NU.010 / NUMBER. JMS TBREAK / VALID BREAK CHARACTER? JMP NUM3 / RETURN WITH BREAK IN THE AC. JMP NUMERR / ERROR OTHERWISE. NU.010 AAC -60 / CONVERT TO OCTAL NUMBER. DAC NUMT / SAVE NUMBER. LAC NUM /YES -- PICK UP THE REAL NUMBER /THAT HAS ALREADY BEEN CONSTRUCTED CLL MUL /MULTIPLY IT BY 10 DECIMAL 12 SZA / HAS THE NUMBER OVERFLOWED? JMP NUMERR / YES, ERROR. LACQ /GET RESULT INTO AC TAD NUMT /ADD THE DIGIT JUST READ DAC NUM /SAVE THE RESULTING DECIMAL NUMBER JMP NUM1 /NO -- READ SOME MORE NUM3 IDX NUMBER /PREPARE TO RETURN AT JMS+2 LAC NUM /PICK UP THE DECIMAL NUMBER LMQ /STORE IT IN THE MQ LAC CHAR /GET THE BREAK CHAR INTO THE AC JMP* NUMBER /RETURN AT JMS+2 NUMERR LAC CHAR /ERROR SO GET CHARACTER INTO AC JMP* NUMBER /AND RETURN AT JMS+1 .EJECT .TITLE *** CHECK FOR ALPHABETIC, NUMERIC, PUNCTUATION *** / / CALLING SEQUENCE: / / LAC CHARACTER / JMS ANP / ALPHABETIC / NUMERIC / PUNCTUATION / / AC IS RESTORED. / ANP XX / ENTRY POINT. CLL / INITIALIZE LINK. DAC CHAR / SAVE AC. TAD (-60) / CHECK FOR PUNCTUATION. SNL!CLL / LINK = 0 IF IN THE APPROPRIATE RANGE. JMP P / PUNCTUATION. TAD (-12) SNL!CLL JMP N / NUMERIC. TAD (-7) SNL!CLL JMP P / PUNCTUATION. TAD (-32) SNL!CLL JMP A / ALPHABETIC. P ISZ ANP / PUNCTUATION. N ISZ ANP / NUMERIC. A LAC CHAR / RESTORE THE AC. JMP* ANP / RETURN TO CALLER. .TITLE *** FIND THE NEXT TERMINAL CHARACTER *** TERMSC XX / ENTRY POINT. SNA / CHARACTER IN THE AC? TE.010 JMS FAC / NO. JMS TBREAK / BREAK CHARACTER? SKP / YES. JMP TE.010 / NO. JMS TERM / CR/AM? ISZ TERMSC / NO. JMP* TERMSC / TAKE NON CR/AM BREAK CHARACTER RETURN. .TITLE *** DECIMAL PRINTING ROUTINE *** / / CALLING SEQUENCE: / / LAC NUMBER / JMS DECPRT / DECPRT XX / ENTRY POINT. / THIS ROUTINE WAS TAKEN FROM STEVE ROOT WHO / GOT IT FROM THE DOS-15 EXECUTIVE WHICH WAS / WRITTEN BY ED GARDNER. I HAVEN'T HAD TIME / TO FIGURE OUT HOW IT WORKS, BUT IT DOES. LMQ / SAVE THE CALLING PARAMETER. LAC (BUFF-1) / SET UP STORING OF CHARACTERS. DAC* (X10) LAC (5003) / WORD COUNT. DAC* X10 DZM* X10 / CHECKSUM. LAW -5 / 5 CHARACTERS. DAC NUMT CLA!CLL!CML RTR MUL-13000 517427 LRS 20 DEC1 AAC 60 DAC* X10 CLL!CLA MUL-13000 12 ISZ NUMT JMP DEC1 AAC 60 DAC* X10 LAC (CR) DAC* X10 LAC (LF) DAC* X10 CAL WRJID CAL WFTEV JMP* DECPRT WRJID 2700 TEV TTOLUN 3 BUFF .END QUEUE