.TITLE XVM/DOS:UC-15 SPOOLER DISK GENERATOR - V1A000 / /COPYRIGHT (C) 1975 /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 PRO- /VIDED 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 COM- /MITMENT BY DIGITAL EQUIPMENT CORPORATION. / /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY /OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. .EJECT / / /COPYRIGHT 1974,75 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / / EDIT 009 BLR FIRST FULL TEST VERSION / EDIT 010 BLR CLEAN UP EXCESS CODE / EDIT 011 BLR CLEAN UP ZERO LENGTH CHOICE BUG / EDIT 012 BLR CLEAN UP ZERO DEFAULT BUG AND WRT LOCK BUG / EDIT 013 BLR CLEAN UP MISTYPE IN RTRANO AND ADD COMMENTS / EDIT 014 BLR XVM UPGRADE / EDIT 015 BLR 19-JUL-75 CHECK FOR DISK ON .DAT-14 / EDIT 016 MJH 20-AUG-75 DISCLAIMER / EDIT 017 BLR 17-SEP-75 FIX ^P BUG / / THIS PROGRAM ENTERS A SPOOLING AREA ON THE SELECTED RK CARTRIDGE /(MOUNTED ON ANY RK UNIT). THIS SPOOLING AREA IS A CONTIGIOUS SERIES OF DISK /BLOCKS USED TO CONTAIN THE SPOOLED INFORMATION.EACH RK CARTRIDGE MAY HAVE /ITS OWN SPOOLER AREA (OR IT MAY HAVE NO SPOOLER AREA) AND MAY BE MOUNTED IN /ANY RK UNIT (RK0-RK7).SPLGEN MAY BE RUN CONCURENTLY WITH THE SPOOLER AS LONG /AS THE RK UNIT BEING SPLGEN-ED IS NOT THE RK UNIT BEING SPOOLED TO. / THE SIZE AND THE STARTING BLOCK OF THE SPOOLER AREA ON AN RK CARTRIDGE /IS STORED IN WORDS 374 (SIZE) AND 375 (STARTNG BLK) OF THE CARTRIDGE'S MFD /(BLOCK 1777).THESE ARE 16 BIT FIELDS. THE REMAINING 2 BITS OF EACH WORD ARE /USED (TOGETHER AS A 4 BIT FIELD) AS A CHECK SUM FOR THESE ENTRIES.THIS IS /PRODUCED BY ADDING THE TWO 16 BIT FIELDS,ADDING 1,AND THEN USING THE LOW ORDER /4 BITS AS THE CHECK SUM (BITS 14-15 ARE STORED IN BITS 0-1 OF WORD 374,BITS /16-17 ARE STORED IN BITS 0-1 OF WORD 375 OF THE MFD). /AFTER THE USER SELECTS WHICK UNIT HE WANTS THE SPOOLER AREA ENTERED /SPLGEN DETERMINES THE LARGEST POSSIBLE SPOOLER AREA THAT WILL FIT ON THAT /CARTRIDGE AND DISPLAYS THAT VALUE. THE USER MAY SELECT ANY VALUE FROM A /MINIMUM OF 100 OCTAL (64 DEC.) TO A MAX OF THE DISPLAYED LARGEST /VALUE OR HE MAY SELECT 0 (NO SPOOLER AREA). A DEFAULT VALUE OF THE SPOOLER /AREA SIZE PREVIOUSLY ON THE CARTRIDGE IS OPTIONAL. THIS PROGRAM IN EFFECT, /ALLOWS THE USER TO ENLARGE AS WELL AS TO REDUCE THE SPOOLER AREA ON ANY /RK CARTRIDGE. / NOTE THAT ALL QUESTIONS HAVE A DEFAULT REPLY DISPLAYED WITH THEM. /A CARRIGE RETURN WILL CAUSE THE DEFAULT TO BE TAKEN AS THE INTENDED VALUE. / / / .DAT SLOT -14 MUST BE ASSIGNED TO THE SYSTEM DEVICE / / PARAMETER ASSIGNMENTS: / DEFINE BIN=0 FOR LINKING LOADER BINARY BIN=0 / .SCOM=100 /SYSTEM COMMUNICATION TABLE SIOA=706001 /UC15 SKIP INSTR. LIOR=706006 /UC15 SEND TCB INSTR. .IFDEF BIN .IODEV -14 .ENDC .TITLE INITIALIZATION / / / START JMS SECTN /IDENTIFY ITSELF; STATE VERSION; SET ^P .SIXBT 'SPLGEN XVM V1A000<@' LAC* (.SCOM+4 /GET ENABLE WORD (BR-014) AND (000002 /TEST FOR UC15 ENABLE (BR-014) SZA /SKIP IF NOT ENABLED (BR-014) JMP GUIC /ENABLED-CONTINUE (BR-015) JMS TERMER /FATAL ERROR -NO UC15 (BR-014) .SIXBT '_>UC15 NOT ENABLED<@' GUIC LAC* (.SCOM+100 /GET TCB TABLE ADDR. IAC /POINT TO SECOND ITEM IN TABLE DAC TCB# /SAVE IT LAC* TCB /GET RK TCB POINTER SNA /TEST FOR EXISTANCE OF TCB ENTRY JMP NOTCB /NO ENTRY - VERY FATAL ERROR -GOODBY DAC TCB /SAVE IT AAC 2 /GET EV POINTER DAC EV# /SAVE EV POINTER AAC 2 /COMPUTE SPLSW POINTER DAC SPLSW# /AND SAVE IT AAC 3 /COMPUTE SPUNIT POINTER DAC SPUNIT# /AND SAVE IT IAC /COMPUTE RKCS POINTER DAC RKCS# /AND SAVE IT IAC /COMPUTE RKER POINTER DAC RKER# /AND SAVE IT IAC /COMPUTE RKDS POINTER DAC RKDS# /AND SAVE IT DZM SATBLP /INITIALIZE SAT CORE BLOCK POINTER (BR-12) .INIT -14,0,0 /SET UP SKIP CHAIN ETC. (BR-015) DEV=.-1 /BUFFER SIZE INDICATES DEVICE TYPE (BR-015) LAC DEV /GET BUFFER SIZE (BR-015) SAD (376 /SKIP IF NOT A DISK (BR-015) JMP MIC /IT IS A DISK - CONTINUE (BR-015) JMS OUT /NOT A DISK ON .DAT-14 - ERROR (BR-015) .SIXBT '_>.DAT -14 DEVICE IS NOT A DISK - ABORT<@' /(BR-015) JMP TERM1 /EXIT DIRECTLY (BR-015) MIC LAC* (.SCOM+42 /CHECK IF LOGGED IN UNDER MIC (BR-015) SPA /SKIP IF NOT (BR-015) JMP GUIC1 /LOGGED IN UNDER MIC (BR-015) JMS TERMER /NOT LOGGED IN UNDER MIC - ERROR (BR-015) .SIXBT '_>SYSTEM PROTECTED<@' /(BR-015) GUIC1 .USER -14,IOS /FOR USE IN DELTNG HNDLR FILES (BR-015) -3&777 /.INIT -3 FOR ^C TO KEEP CONTROL UNTIL 1 /READY TO RELINGQUISH IT EVEN IN FACE 200000+ENDGEN /OF ^C; RIGHT NOW IT CAUSES DELETION 0 /OF TEMPORARY FILE CREATED TO STORE /SYSTEM INFORMATION LAC (A1 /PUT IN TRANSFER VECTOR FRESH DAC DEVICE /IN CASE OF ^P RETURN .FSTAT -14,A1 /A1 .SIXBT 'SPLGENDMP' UNIT=.-2 DEVICE=.-1 /PICK OUT UNIT # FROM CAL CODE AND /PICK DEVICE # FROM BITS 0-2 /OF TRANSFER VECTOR TO FILE NAME SNA /IF FILE SPLGENDMP IS PRESENT DELETE IT JMP RKDSK /NOT PRESENT .DLETE -14,A1 /DELETE SPLGEN DMP .TITLE RK UNIT SELECTION RKDSK JMS QUERY /ASK FOR UNIT # .SIXBT 'RK UNIT # [<@' CLA /DEFAULT 0 DZM RKUNIT# /DEFAULT 0 JMS NUMSUP /SUPRESS LEADING ZEROS JMS OUT /TYPE REST OF QUESTION .SIXBT '] <@' /BRACKET CLA /ANS MUST TERM. WITH CR OR ALT JMS ANS /GET ANS JMP RKDSK /BAD SYNTAX JMP A.2 /DEFAULT ANS JMP ALTBAD /ALT ONLY-IS BAD JMP SYMBAD /SYMBOL IS BAD SPA /RANGE TEST (0-7) ONLY JMP RANGE /RANGE ERROR TAD (-10) /UPPER BOUND IS 7 SMA /TEST JMP RANGE /BAD LAC NUMBER /GET ANS DAC RKUNIT /SAVE IT A.2 LAC LRK /SAVE RK MNEMONIC DAC LITDEV LAC (SPTCB /GET ADR. OF SPL-STAT. TCB DAC TASK# /SET UP MOVTCB CALL LAW -10 /SIZE OF SPTCB JMS MOVTCB /MOVE TCB TO MONITOR REGION (RK TCB SLOT) JMS TCBIO /SEND TCB JMP SDER /FATAL SOFTWARE DIR. ERROR EXIT LAC* SPLSW /GET SPLSW AND (100000 /TEST FOR ACTIVE SPOOLER SNA /SKIP IF SPOOLER ALIVE JMP DOMFD /SPOOLER NOT RUNNING - NO PROBLEM LAC* SPUNIT /GET CURRENT SPOOLER UNIT SAD RKUNIT /TEST TO SEE IF THE SAME AS SELECTED UNIT JMP SAMERK /YES - FATAL - MUST NOT UPDATE SPOOLER /AREA ON UNIT WITH ACTIVE SPOOLER /GET OUT QUICK !!! DOMFD LAC RKMFD /GET BLOCK '1777' JMS RTRANI /SUBROUTINE TO .TRAN INTO CORE LAC (SAT /FIRST ADDRESS OF CORE BUFFER IS SAT LAC SAT+374 /GET SPOOLER AREA SIZE FROM MFD AND (177777 /CLEAR OUT CHECK BITS DAC TEMP /SAVE LAC SAT+375 /GET SPOOLER AREA START BLOCK # AND (177777 /CLEAR OUT CHECK BITS TAD TEMP /COMPUTE CHECK BITS - FOR VALIDITY CHECK IAC /SO THAT 0 DOESNT VERIFY AND (17 /CLEAR OUT UNWANTED BITS DAC TEMP /SAVE COMPUTED VALUE LAC SAT+374 /GET SPOOLER AREA SIZE CLL /CLEAR LINK FOR SHIFTS LRS 20 /GET CHECK BITS PAL /SAVE THEM LAC SAT+375 /GET SPOOLER AREA BLOCK # LRS 22 /SHIFT CHECK BITS INTO MQ PLA /GET OTHER CHECK BITS LLS 2 /FORM 4 BIT CHECK SUM SAD TEMP /DO THE CHECK BITS VERIFY ? SKP /YES - SKIP DZM SAT+374 /ZAP SIZE - SO THAT SIZE QUESTION /PRINTOUT WILL BE CORRECT LAC SAT+374 /GET VALUE OF SIZE AND (177777 /CLEAR OUT POSSIBLE CHECK BITS DAC SPSIZ# /SAVE IT LAC SAT+375 /GET STARTING BLOCK # AND (177777 /CLEAR OUT CHECK BITS DAC SPSTRT# /SAVE IT /ROUTINE TO INITIALIZE TEMPORARY SYSTEM /FILE TO STATE OF OLD SYSTEM. .EJECT DZM NOSATB /INITIALIZE ACCUMULATOR FOR # /SAT BLOCKS LAC* (.SCOM+2 /ALLOCATE FREE CORE FOR SAT BLOCK TABLE DAC SATABP DAC BTABP DAC BPTR LAC SAT+3 /FIND FIRST BLOCK OF SAT FROM 4TH AND (77777 /WORD OF MFD BITS 3-17 SKP /ENTER ALGORITHM IN MIDDLE FSAT1 LAC SAT+377 /FETCH NEXT BLOCK # OF SAT SAD (-1 /IF NONEXISTENT THEN WE ARE THROUGH JMP FSAT2 /FINISHED JMS DACFRE /STORE INTO SAT BLOCK TABLE BTABP /AND CHECK FOR OVERFLOW OF FREE CORE ISZ NOSATB /INCREMENT # OF SAT BLOCKS IN SYSTEM JMS RTRANI /.TRAN IN SAT BLOCK FOR NEXT LAC (SAT JMP FSAT1 /ITERATE FSAT2 LAC NOSATB /COMPUTE -# OF SAT BLOCKS TCA DAC DECT1 TAD (-3 DAC ALCT1 /# OF BLOCKS OF DUMMY DUMP MODE FILE LAC BTABP /SET UP LOOP POINTERS DAC P1 TAD NOSATB DAC ODATE /START OF OLD .DAT SLOT TABLE IN FREE DAC CGEND /CORE TCA TAD* (.SCOM+3 /DOES IT FIT SPA JMP OVFLO1 /NO; ANNOUNCE TERMINAL ERROR .EJECT / / WRITE DUMMY FILE TO CONTAIN SYSTEM INFORMATION /UNTIL IT IS READY TO BE SUBSTITUTED FOR OLD SYSTEM INFORMATION. /THIS IS DONE THIS WAY SO THAT IF A PERSON MAKES A MISTAKE /WHILE SYSTEM GENERATING NO HARM WILL BE DONE UNLESS HE /COMPLETES THE WHOLE PROCESS WITHOUT DISCOVERING HIS ERROR OR /ABORTING THE OPERATION THROUGH SOME TERMINAL ERROR DISCOVERED /BY THE SYSTEM GENERATOR. / .INIT -14,0,0 /.INIT DISK HANDLER .ENTER -14,A1 /WRITE FILE 'SPLGEN DMP' /SAT TO TEMPORARY FILE TO # OF SAT BLOCKS PRE1 -14&777+4000 /.WRITE IN DUMP MODE 11 SAT /ANY BUFFER WILL DO THAT IS LEGAL MEMORY -376 /ONE BLOCK ISZ ALCT1 /COUNT UP TO # DESIRED JMP PRE1 /ITERATE UNTIL DESIRED # OF BLOCKS WRITTEN .CLOSE -14 /RECORD THE FILE IN THE DIRECTORY LAW -1 /THIS SETS UP A COUNTER TO SIGNAL DAC BCTR /THAT THE SYSTEM BLOCKS ARE TO /READ AFTER THE SAT BLOCKS HAVE BEEN /RECORDED .INIT -14,0,0 /GET READY TO FIND OUT BLOCK NUMBERS .EJECT .FSTAT -14,A1 /BY .FSTAT TO FILE AND TRANSFERING SNA /SYSTEM BLOCKS AT THE SAME TIME JMP BADDEV /A 0 AC INDICATES THE FILE IS MISSING /WHICH MAKES NO SENSE; TERMINATE SKP /JUMP INTO ALGORITHM WITH FIRST BLOCK PRE3 LAC ALFA /THE LINK TO THE NEXT BLOCK THAT /IS IN THE DUMMY FILE IS USED FOR THE DAC* P1 /NEXT BLOCK OF THE BIT MAP AND RECORDED SAD (-1 /CHECK FOR NON-EXISTENT BLOCK JMP BADDEV /BAD SYSTEM JMS TRANIN /IN THE BLOCK TABLE; THE BLOCK LAC (SAT /IS BROUGHT INTO CORE FOR THE LINK BLOCK LAC SAT+377 /# WHICH IS SAVED IN ALFA AS BEFORE DAC ALFA /FOR USE LATER WHEN THE NEXT ITERATION LAC* BPTR /NEEDS A BLOCK; NOW THE NEXT BLOCK IS JMS RTRANI /BROUGHT INTO CORE AND WRITTEN ONTO LAC (SAT /THE DUMMY BLOCK FOUND LAST ITERATION LAC* P1 /THIS IS STILL THE BLOCK JMS TRANOT /.TRAN OUT LAC (SAT ISZ BCTR /A COUNT IS TAKEN OF THE BLOCKS WRITTEN JMP PRE2 /AND ON THE FIRST BLOCK THE # BLOCKS LAC SAT /IN THE SYSTEM IS TAKEN FROM THE DAC NOBSYS /FIRST WORD OF THE SAT AND STORED LAC SAT+1 /INTO NOBSYS; THE #BLOCKS IN EACH DAC NOBPSB /MAP IS RECORDED IN NOBPSB TCA /AND COMPLEMENT DAC CNOBPS /IN CNOBPS DZM SATMOD /THE BLOCK IN CORE IS INDICATED AS /UNMODIFIED PRE2 ISZ P1 /BUMP DUMMY SAT BLOCK TABLE POINTER ISZ BPTR /BUMP THE SAT BLOCK TABLE POINTER ISZ DECT1 /COUNT THE SAT BLOCKS UNTIL FINISHED JMP PRE3 /NOT FINISHED; ITERATE .TITLE SPOOLER AREA DEALLOCATION AND ALLOCATION ROUTINE LAC SPSIZ /GET CURRENT SPOOLER AREA SIZE SNA /SKIP IF THERE IS ONE JMP BLKMAX /DON'T DEALLOCATE A ZERO AREA JMS DEALOC /DEALOCATE THE CURRENT AREA LAC SPSTRT /PARAM. TO DEALOC - START OF AREA BLKMAX LAC (40000 /GET AN UNREASONABLE NUMBER JMS ALLOC /TRY TO ALLOCATE IT JMP ACNTX /WHEN YOU FAIL SEE HOW MUCH ROOM THERE IS /ACTUALY AVAILABLE JMS TERMER /RK SAT TO BIG - FATAL ERROR .SIXBT '>FAILURE - RK SAT TOO LARGE<@' ACNTX JMS OUT /TYPE MAX AVAILABLE BLOCKS .SIXBT '_>MAXIMUM AVAILABLE BLOCKS <@' LAC ALCT3 /GET MAX # OF BLOCKS JMS NUMSUP /SUPRESS LEADING ZEROS JMS OUT /COMPLETE MESSAGE .SIXBT ' _<@' LAW -100 /TEST FOR MIN USEABLE SPOOLER AREA (64 BLOCKS) TAD ALCT3 /SUBTRACT MAX FROM 64 SMA /SKIP IF TOO SMALL AN AREA JMP WHATSZ /OK - GO GET NEW SIZE JMS TERMER /FATAL - NOT ENOUGH ROOM TO ALLOCATE .SIXBT '>INSUFFICIENT CONTIGUOUS BLOCKS FOR SPOOLER AREA<@' WHATSZ JMS QUERY /ASK FOR DESIRED NUMBER OF BLOCKS .SIXBT 'SPOOLER AREA SIZE [<@' LAC SPSIZ /SHOW DEFAULT SIZE JMS NUMSUP /PRINT NR. WITH NO LOADING ZEROS JMS OUT /TERMINATE PRINOUT .SIXBT '] <@' CLA /ANS. MUST TERMINATE WITH CR. OR ALT. JMS ANS /GET ANS. JMP WHATSZ /BAD SYNTAX JMP A.3 /DEFAULT JMP ALTBAD /ALT ONLY - IS BAD JMP SYMBAD /SYMBOL IS BAD SPA /NEGATIVE ANS IS BAD JMP BRANGE /SAY SO AND RETRY TCA /NEGATE TAD ALCT3 /TEST FOR MAX VIOLATION SPA /SKIP IF WITHIN RANGE JMP BRANGE /MAX VIOLATION - SAY SO AND RETRY LAW -100 /TEST FOR MIN. (0@>MODIFYING SYSTEM(^P,^C IGNORED)_<@' I.1 LAC SATABP /NEW SAT INTO PLACE DAC BPTR LAC NOSATB /# OF SAT BLOCKS TCA DAC DECT1 LAC BTABP DAC P1 I.1B LAC* P1 /OUTPUT NEXT SAT BLOCK JMS TRANIN LAC (SAT LAC* BPTR JMS RTRANO /WRITE TO RK VIA DIRECT TCB LAC (SAT ISZ P1 /BUMP TO NEXT SAT BLOCK ISZ BPTR ISZ DECT1 /DONE? JMP I.1B /NO; ITERATE LAC RKMFD /GET RK MFD BLOCK NUMBER JMS RTRANI /READ IN BLOCK LAC (SAT /INTO SAT BUFFER LAC SPSIZ /GET SPOOLER AREA SIZE TAD SPSTRT /ADD SPOOLER STARTING BLOCK # IAC /INC. TO INVALIDATE TWO 0'S LLS 16 /SHIFT CHECK BITS INTO HIGH ORDER BITS PAL /SAVE IMAGE AND (600000 /CLEAR OUT ALL BUT 2 CHECK BITS TAD SPSIZ /ADD SPOOLER AREA SIZE DAC SAT+374 /STORE IN MFD+374 PLA /GET IMAGE OF CHECK BITS RTL /GET OTHER TWO CHECK BITS INTO HIGH END AND (600000 /CLEAR OUT JUNK - LEAVING CHECK BITS TAD SPSTRT /ADD SPOOLER STARTING BLOCK # DAC SAT+375 /SAVE IN MFD+375 LAC RKMFD /GET MFD BLOCK NUMBER JMS RTRANO /WRITE IT TO RK VIA DIRECT TCB LAC (SAT /IMAGE BEGINS AT 'SAT' I.12 JMS OUT /ANNOUNCE SPLGEN COMPLETE .SIXBT '_>@>SPLGEN COMPLETE_<@' JMP ENDGEN BADDEV JMS TERMER /FATAL ERROR;INTEGRITY OF DAT -14 .SIXBT '>.DAT -14 SYSTEM FAILURE<@' /IN DOUBT .TITLE TELETYPE OUTPUT ROUTINE / / ENTRY POINTS OUT AND OUTP /THE FOLLOWING ILLUSTRATES THE USES OF THIS ROUTINE / JMS OUT /MESSAG .SIXBT '_>HOW ARE YOU<@' /THIS PRINTS THE TEXT STRING HOW ARE YOU AND STOPS RETURNING /CONTROL TO THE POINT AFTER THE MESSAGE. THE FOLLOWING ROUTINE /ILLUSTRATES THE USE OF OUTP ENTRY: / JMS OUTP / LAC (MESSAG / /RETURN HERE ON COMPLETION /BOTH THESE ROUTINES PERFORM EXACTLY THE SAME FUNCTION. THE /CHARACTERS '_','>', AND '<' WHEN NOT DOUBLED ARE INTERPRETED /AS CARRIAGE RETURN, TAB (HORIZONTAL), AND END OF MESSAGE. THE /END OF MESSAGE CHARACTER MUST BE FOLLOWED BY AN @ SIGN. IF THEY /APPEAR DOUBLED THEY WILL BE PRINTED ONCE AND THE SECOND ONE /IGNORED. QUADRUPLED WILL PRINT TWICE ETC. / OUTP XX XCT* OUTP /FETCH TRANFER VECTOR TO MESSAGE DAC OUT /STORE IN OUT FOR MESSAGE PRINTING LAC (JMP* OUTP /FETCH EXIT INSTRUCTION JMP OUT1 /JUMP INTO OUT ROUTINE KLCNT 0 TVCNT 0 LASCR 0 /PREVIOUS CHARACTER WHICH IS WAITING TO BE OUTPUT KLCNTB 0 OUT 0 /POINTS TO FIRST WORD OF MESSAGE LAC (JMP* OUT /FETCH RETURN INSTRUCTION OUT1 DAC OUTEX /STORE AWAY RETURN INSTRUCTION DZM LASCR /PREVIOUS CHARACTER AT FIRST IS NULL LAW -1 /SET UP FOR BEGINNING DAC KLCNT DZM KLPUT /.INIT BUFFER JMS OUTLIN MSNXTC ISZ KLCNT /IS THIS THE FIRST CHARACTER JMP KLFSXT /NO LAC* OUT /YES; FETCH NEW WORD ISZ OUT /BUMP POINTER DAC TVCNT /STORE LAW -3 /3 CHAR. PER WORD DAC KLCNT KLFSXT LAC TVCNT /FETCH OUTPUT RTL /6 LEFT RTL RTL DAC TVCNT /STORE FOR NEXT CHAR RAL /GET LINK INTO AC 17 AND (77 /CLEAN DAC KLCNTB /SAVE AND (40 SNA!STL /IS CHAR. IN NEED OF 100? CLL LAC KLCNTB SNL!SZA!CLL XOR (100 /YES DAC KLCNTB /STORE AWAY TEMPORARILY SAD LASCR /IS THIS THE SAME AS THE LAST CHARACTER? STL /YES; LINK IS 0 FROM ABOVE LAC LASCR /PRINT LAST CHARACTER SNL JMP KLFS1 /NOT ONE OF THE SPECIAL CHARACTERS SAD (137 /CHECK IF SPECIAL CHARACTER DZM KLCNTB /YES; PRINT ONCE AND STOP SAD (76 /> DZM KLCNTB SAD (74 /< DZM KLCNTB JMP KLFS3 /OMIT CHECKING FOR SPECIAL CHARACTERS KLFS1 SAD (137 /_ MEANS CAR. RET. LF JMP MSCRLF SAD (74 /< MEANS END OF MESSAGE JMP MPEND SAD (76 /> MEANS TAB LAC (11 KLFS3 SZA /@ MEANS IGNORE JMS KLPUT /PUT IN OUTPUT BUFFER KLFS2 LAC KLCNTB /PUT NEW CHARACTER INTO LAST CHARACTER DAC LASCR JMP MSNXTC /GET ANOTHER CHARACTER MSCRLF JMS OUTLIN /OUTPUT LINE JMS CRLF /GIVE A CAR.RET.LF JMP KLFS2 /START NEW LINE MPEND JMS OUTLIN /OUTPUT LINE IF NECESSARY OUTEX XX /EXIT INSTRUCTION COMPUTED .EJECT / /IOPS ASCII PACKING ROUTINE / KLPUTP 0 KL57 0 KLCHR2 0 KLLIT JMP KLJ57 KLPUT 0 AND (177 /CLEAN OFF DAC KLCHR2 /SAVE CLL LAC KL57 /GET CHARACTER POSITION TAD KLLIT /COMPUTE JMP DAC .+2 LAC KLCHR2 XX /MODIFIED JMP KLJ57 JMP KL571 /CHAR1 JMP KL572 /CHAR2 JMP KL573 /CHAR3 JMP KL574 /CHAR4 JMP KL575 /CHAR5 KL571 RTR /8 RIGHT RTR RTR RTR KL571A DZM* KLPUTP /CLEAR WORD JMP KLND57 KL572 RTL /4 LEFT RTL JMP KLND57 .EJECT KL573 RTR /FIRST 4 CHAR RAR AND (17 /CLEAN OFF XOR* KLPUTP DAC* KLPUTP ISZ KLPUTP /LAST WORD OF PAIR LAC KLCHR2 /2ND HALF RTR /4 RIGHT RTR AND (700000 JMP KL571A KL574 RTL /8 LEFT RTL RTL RTL JMP KLND57 KL575 RAL DZM KL57 /START WITH NEW WORD PAIR SKP KLND57 ISZ KL57 /BUMP CHAR. POINTER XOR* KLPUTP DAC* KLPUTP LAC KL57 SNA ISZ KLPUTP /2ND WORD COMPLETE JMP* KLPUT .EJECT / /OUTPUT A LINE IF NECESSARY / OUTLIN 0 LAC KLPUT /HAS ANYTHING BEEN PACKED SNA JMP OUTL /NO EXIT LAC (175 /PACK FINAL ALT MODE JMS KLPUT DZM KLPUT /CLEAR PACKING FLAG JMS IOSUP /IS I/O SUPRESSION ON JMP OUTL /YES DO NOT OUTPUT CAL 2775 /.WRITE -3 IOPS ASCII 11 TYOBFP TYOBUF /BUFFER ADDRESS -46 .WAIT -3 /WAIT FOR COMPLETION OUTL LAC TYOBFP /SET UP BUF POINTERS TAD (2 DAC KLPUTP DZM KL57 JMP* OUTLIN .EJECT / /PRINT AC IN OCTAL WITH 0 SUPRESSION / NUMSUP 0 DZM SUP ISZ SUP JMS SUPOCT JMP* NUMSUP SUPOCT 0 DAC SUPO1 /SAVE AC LAW -6 /6 DIGITS DAC SUPO2 TYPE61 LAC SUPO1 /UNSAVE # RTL /ROTATE 3 LEFT RAL DAC SUPO1 /STORE FOR NEXT TRY RAL /GET FROM LINK AND (7 /CLEAN SNA JMP .+3 DZM SUP /FIRST NON-ZERO DIGIT SKP SAD SUP /SUPRESSION ON? JMP TYPE62 /NO LAW -1 /YES, LAST 0? SAD SUPO2 SKP!CLA /YES PRINT JMP .+3 /NO OMIT TYPE62 XOR (60 JMS KLPUT /PACK ISZ SUPO2 JMP TYPE61 JMS OUTLIN /OUTPUT NUMBER JMP* SUPOCT SUP 1 SUPO1 0 SUPO2 0 .EJECT / /PRINT AC WITHOUT 0 SUPPRESSION / NUMOUT 0 DZM SUP JMS SUPOCT JMP* NUMOUT / /PRINT AC AS SIGNED NUMBER WITH 0 SUPPRESSION / SOCT 0 SMA JMP SOCT1 TCA /FORM TWO'S COMPLEMENT DAC SUPOCT /STORE TEMPORARILY LAW 55 JMS KLPUT /STORE MINUS INTO OUTPUT BUFFER LAC SUPOCT /UNSAVE NUMBER SOCT1 JMS NUMSUP /PRINT NUMBER WITH ZERO SUPRESSION JMP* SOCT /EXIT .TITLE DISK I/O ROUTINES / / STD. DISK I/O IN SPLGEN GOES TO .DAT -14 AND CONSISTS OF /.TRANS. A TRAN OUT ALWAYS IS READ CHECKED BY THE HANDLER. /EACH .TRAN IS FROM OR TO THE 256 WORD BLOCK NUMBER IN THE AC. THE /FOLLOWING ARGUMENT (TO JMS TRANIN OR JMS TRANOT) IS AN /INSTRUCTION TO LOAD THE FIRST ADDRESS OF THE CORE AREA INVOLVED /INTO THE AC. / CALLING SEQUENCE: / LAC BLKNO /LOAD BLOCK # / JMS TRANIN /OR JMS TRANOT / LAC (FIRST /FIRST CORE LOCATION / /RETURN / TRANIN 0 DAC BLKIN /STORE AWAY BLOCK 3 IN MACRO XCT* TRANIN /PICK UP THE FIRST CORE LOCATION DAC FRADIN /STORE AWAY IN .TRAN MACRO -14&777+10000 /.INIT TO READ CHECK 1 0 0 -14&777 /.TRAN IN 13 BLKIN XX /BLOCK # FRADIN XX /FIRST CORE ADDRESS NWDIN -400 /256 WORDS .WAIT -14 JMP* TRANIN /EXIT TRANOT 0 DAC BLKOT /STORE AWAY BLOCK # IN MACRO XCT* TRANOT /PICK UP FIRST CORE ADDRESS DAC FRADOT -14&777+11000 /.INIT TO WRITE CHECK 1 0 0 -14&777+1000 /TRAN OUT -14 13 BLKOT XX /BLOCK # FRADOT XX /FIRST ADDRESS NWDOT -400 /256 WORDS .WAIT -14 JMP* TRANOT / / / / ALL RK SPOOLER ORRIENTED I/O USES DIRECT TCBS TO DO THE / RK DISK I/O. THIS SUBROUTINE SET PROVIDES VERY LIMITED / ERROR DETECTION AND CORRECTION. / / ONLY WRITE PROTECT AND NON-EXISTENT DRIVE ERRORS ARE / RECOVERABLE - ALL OTER ERRORS ARE FATAL ! / / THE CALLING SEQUENCE IS IDENTICAL TO THAT OF THE STANDARD / DISK ROUTINES WITH RTRANI REPLACING TRANIN AND / RTRANO REPLACING TRANOT / / RTRANI 0 /ENTRY POINT DAC RBLKN /STORE BLOCK NR IN TCB CLA!CLL /CLEAR AC AND LINK AAC 4 /SET UP READ FCN. DAC RFCN /SAVE IN TCB XCT* RTRANI /PICK UP ADR. OF BUFFER JMS RKIO /DO THE I/O JMP* RTRANI /IF NO ERROR - RETURN TO CALLER / / / RTRANO 0 /ENTRY POINT DAC RBLKN /STORE BLOCK NR IN TCB CLA!CLL /CLEAR AC AND LINK AAC 2 /SET UP WRITE FCN. DAC RFCN /SAVE IN TCB XCT* RTRANO /PICK UP ADR. OF BUFFER (BR-013) JMS RKIO /DO THE I/O JMP* RTRANO /IF NO ERROR - RETURN TO CALLER / / / RKIO 0 /ENTRY POINT OF RK DIRECT I/O VIA TCB HANDLER DAC RKLSA /STORE LSB OF BUFFER ADR. IN TCB LRS 20 /GET MSB OF BUFFER ADR. DAC RKMSA /STORE IN TCB LAC RKUNIT /GET UNIT NR. ALS 10 /POSITION IT TAD RFCN /ADD FUNCTION DAC RFCN /STORE IN TCB LAC (RKTCB /GET TCB ADR. DAC TASK /SET UP MOVE LAW -13 /GET SIZE OF TCB JMS MOVTCB /MOVE TCB INTO DOS MONITOR BUFFER JMS TCBIO /SEND IT TO THE UC15 NOP /PIREX INDICATES ERRORS IN TCB - NOT VIA EV -WHEN /DOING DISK I/O LAC* RKDS /CHECK FOR WRITE PROTECTED DRIVE (BR-12) AND (40 /BIT 5 IS WRITE PROT SW. STATUS (BR-12) SZA /SKIP IF NOT WRITE PROTECTED (BR-12) JMP WRTLK /DRIVE PROTECTED - DO SOMETHING (BR-12) LAC* RKCS /GET RETURNED CONTROL REGISTER VALUE AND (100000 /TEST FOR ANY ERROR SNA /SKIP IF ERROR JMP* RKIO /OK - RETURN TO CALLER LAC* RKER /GET RK ERROR REGISTER COPY AND (20000 /TEST FOR WRITE PROTECTED DRIVE SZA /SKIP IF DRIVE NOT WRITE PROTECTED JMP WRTLK /DRIVE PROTECTED - DO SOMETHING LAC* RKER /GET RK ERROR REGISTER COPY AND (200 /TEST FOR POSSIBLE NONEXISTENT DRIVE SZA /SKIP IF DRIVE EXISTS JMP NERK /GO SEE IF IT REALY EXISTS HDER JMS TERMER /FATAL ERROR - SAY SO AND EXIT .SIXBT '>FATAL RK DISK ERROR<@' WRTLK JMS RESET /CLEAN UP MESS JMS RERR /SAY WRITE PROTECTED AND RECOVER .SIXBT 'IS A WRITE PROTECTED UNIT<@' NERK LAC* RKDS /GET COPY OF RKDS AND (4000 /TEST FOR RK05 DRIVE SZA /SKIP IF NON-EXISTENT DRIVE JMP HDER /DRIVE EXISTS - HARD ERROR JMS RESET /CLEAN UP MESS JMP RANGE /AND GIVE RECOVERABLE ERROR MESSAGE / / / RESET 0 /ENTRY POINT LAC RKUNIT /GET UNIT NR. FOR ERROR MESSAGES DAC NUMBER /AND STORE IT LAC (GUIC /GET RECOVERY ADDRESS DAC BADSYN /AND STORE IT -3&777 /INIT .DAT -3 (TTY) FOR VECTORED CONTROL P,C 1 /DITTO 200000+ENDGEN /DITTO 0 /DITTO JMP* RESET / / / .TITLE BLOCK ALLOCATION ROUTINES / / / IMPORTANT VARIABLES / BMASK 0 /ALL 0'S EXCEPT A 1 WHERE BLOCK IS IN BITMAP SATWP 0 /POINTER TO WORD IN SAT IN CORE NBLOCK 0 /CORRESPONDING BLOCK NUMBER SATBLP 0 /BLOCK # OF SAT IN CORE SATMOD 0 /0 IF SAT IN CORE NOT MODIFIED NOBPSB 0 /# OF BLOCKS REPRESENTED IN EACH SAT BLOCK CNOBPS 0 /-# OF BLOCKS REPRESENTED IN EACH SAT BLOCK NOBSYS 0 /# OF BLOCKS IN SYSTEM ALNB 0 /# OF BLOCKS TO BE ALLOCATED ALCT2 0 /-# OF BLOCKS TO BE ALLOCATED ALFB 0 /FIRST BLOCK OF ALLOCATED AREA ALCT1 0 /-# OF FREE BLOCKS MORE NEEDED ALCT3 0 /-MAX NR. OF CONTIG. FREE BLOCKS FOUND DURING FAILURE / / LAC NB /AC NUMBER OF BLOCKS / JMS ALLOC /TO BE ALLOCATED / JMP NORUM /NO ROOM FOR IMAGE / DAC FB /AC CONTAINS FIRST BLOCK # / ALLOC XX DAC ALNB /SAVE NB TCA /COMPUTE -# DAC ALCT1 /SAVE DAC ALCT2 DZM ALCT3 /CLEAR MAX BLOCK COUNTER (BR-017) CLA JMS FINDB /FIND FIRST BLOCK JMP ALLOCX /NO ROOM JMP ALLOC2 ALLOC1 JMS FNB /FIND NEXT BLOCK JMP ALLOCX /NO ROOM ALLOC2 SNA /FREE? JMP ALLOC3 /YES JMS ALMAX /COMPUTE MAX AVAIL SPACE LAC ALCT2 /GET ORIGIONAL DAC ALCT1 JMP ALLOC1 ALLOC3 ISZ ALCT1 /IS THIS THE LAST JMP ALLOC1 /NO LAC NBLOCK /COMPUTE FIRST BLOCK TAD ALCT2 TAD (1 DAC ALFB /SAVE LAC ALNB /ALLOCATE THE STORAGE JMS XORSAT SNA /ALLOCATE LAC ALFB /FIRST BLOCK ALLOC4 ISZ ALLOC /BUMP RETURN JMP* ALLOC /FIRST BLOCK IN AC ALLOCX JMS ALMAX /GET MAX AVAIL SPACE JMP* ALLOC /AND RETURN ALMAX 0 /ENTRY POINT LAC ALCT1 /GET CURRENT COUNT TCA /MAKE POSITIVE TAD ALCT2 /GET STARTING COUNT TAD ALCT3 /GET LAST MAX SMA /SKIP IF A NEW MAX EXISTS JMP* ALMAX /EXIT IF NOT TCA /MAKE POSITIVE TAD ALCT3 /COMPUTE NEW MAX DAC ALCT3 /AND SAVE IT JMP* ALMAX /RETURN .EJECT / / LAC NB /AC CONTAINS NUMBER OF BLOCK TO BE / JMS DEALOC /DEALLOCATED / LAC FB /FIRST BLOCK / /RETURN / DEFB XX /FIRST BLOCK TO BE DEALOCATED DENB XX /NUMBER OF BLOCKS TO BE DEALLOCATED DEALOC 0 DAC DENB /SAVE XCT* DEALOC /PICK UP TEST DAC DEFB LAC DENB /FLIP BITS IN MAP JMS XORSAT SZA /SHOULD BE CLEARED LAC DEFB JMP* DEALOC / / / ROUTINE TO XOR BIT IN SAT / LAC NB /PUT NUMBER OF BLOCKS IN AC / JMS XORSAT /CALL XORSAT / XX /TEST INSTRUCTION WHICH SKIPS / /WHEN STATE OF BIT IS CORRECT / /SKP WHEN DON'T CARE / /SNA WHEN ALLOCATING / /SZA WHEN DEALLOCATING XORCT XX /-# OF BLOCKS TO BE ALLOCATED OR /DEALOCATED FB1 XX /FIRST BLOCK TO BE ALLOCATED OR /DEALLOCATED NB1 XX /# OF BLOCKS TO BE ALLOCATED OR /DEALLOCATED XORSAT XX DAC NB1 /SAVE TCA /COMPUTE -NB DAC XORCT LAC* XORSAT /PICK UP TEST INSTRUCTION ISZ XORSAT /BUMP TO NEXT ARGUMENT DAC XORIN LAC* XORSAT /PICK UP INSTRUCTION DAC .+1 XX /PICK UP FIRST BLOCK DAC FB1 /FIRST BLOCK SAVE LAC (SKP /IF PUTTING THINGS BACK DON'T MESS SAD XORIN /WITH TABLE OF CHANGES JMP XORS1 LAC NB1 /ADD TO TABLE JMS DACFRE CGEND LAC FB1 JMS DACFRE CGEND XORS1 LAC FB1 /FIND FIRST BLOCK JMS FINDB JMP MAPER /NON-EXISTENT JMP XORS3 /JMP INTO MIDDLE OF ALGORTHM XORS2 JMS FNB /FIND NEXT BLOCK JMP MAPER /NON-EXISTENT XORS3 JMS XORB /XOR BIT FOR BLOCK XORIN XX /TEST IF BIT MAP CORRECT JMP MAPER /ERROR ISZ XORCT /DONE? JMP XORS2 /NO; ITERATE JMS WBWN /WRITE OUT BLOCK IF MODIFIED JMP* XORSAT /EXIT MAPER JMS TERMER /TERMINAL ERROR; BIT MAP CONTAMINATED .SIXBT 'BAD SAT<@' .EJECT / / FIND NEXT BLOCK ALGORTHM / JMS FNB / /RETURN / /RETURN SUCCESSFUL WITH AC / /CONTAINING BIT FROM MAP / FNB 0 ISZ NBLOCK /BUMP BLOCK COUNT LAC NBLOCK JMS FINDB /FIND BLOCK JMP* FNB /NON-EXISTENT ISZ FNB /BUMP TO SUCCESSFUL JMP* FNB /EXIT RANGE JMS RERR /RECOVERABLE ERROR .SIXBT 'NON-EXISTENT RK UNIT # <@' .EJECT / / FIND BLOCK IN AC / LAC BLOCKNO / JMS FINDB / /RETURN NON-EXISTENT BLOCK / /RETURN AC CONTAINS SAT BIT BCTR XX /COUNTER WPTR XX /WORD IN SAT STARTING FROM 0 BPTR XX /# OF SAT BLOCK STARTING FROM 0 FINDB XX DAC NBLOCK DZM BPTR TCA /TEST FOR LEGAL BLOCK # TAD NOBSYS /# OF BLOCKS IN SYSTEM SPA!SNA /BLOCK # TOO HIGH? JMP* FINDB LAC NBLOCK ISZ FINDB /BUMP TO SUCCESSFUL EXIT FIN1 TAD CNOBPS /COMPUTE BIT MAP SPA JMP FIN2 /FOUND ISZ BPTR /NEXT BIT MAP JMP FIN1 /ITERATE FIN2 TAD NOBPSB /FIND WORD DZM WPTR /FIRST WORD FIN3 TAD (-22 /18 BITS PER WORD SPA JMP FIN4 ISZ WPTR JMP FIN3 /ITERATE FIN4 DAC BCTR /CALCULATE MASK OF BIT IN SAT CLA!STL RAL ISZ BCTR JMP .-2 DAC BMASK /STORE MASK LAC (SAT+3 TAD WPTR DAC SATWP /POINTER TO WORD FOR BLOCK IN QUESTION LAC BTABP TAD BPTR SAD SATBLP /BLOCK ALREADY IN CORE JMP FIN5 /YES JMS WBWN /WRITE OUT OLD BLOCK IF CHANGES LAC BTABP /CALCULATE BLOCK POINTER FOR RIGHT /SAT BLOCK IN DUMMY TABLE TAD BPTR DAC SATBLP LAC* SATBLP /BRING IN BLOCK JMS TRANIN LAC (SAT FIN5 LAC* SATWP /EXIT WITH WORD IN AC AND BMASK /CONTAINING BIT IN MAP JMP* FINDB /EXIT / / WRITE OUT SAT BLOCK IF MODIFIED / JMS WBWN / /RETURN / WBWN 0 ISZ SATMOD /BLOCK MODIFIED JMP* WBWN /NO LAC* SATBLP /OUTPUT BLOCK JMS TRANOT LAC (SAT JMP* WBWN /EXIT / / XOR BIT IN SAT / XORB 0 LAW -1 DAC SATMOD /SAT MODIFIED LAC* SATWP /FIP BIT XOR BMASK /BY XORING DAC* SATWP /STORE BACK INTO SAT AND BMASK /CLEAN OFF SZA!CLC /COMPUTE WHETHER BLOCK ADDED OR DELETE LAC (1 TAD SAT+2 DAC SAT+2 LAC* SATWP AND BMASK /LEAVE WITH BIT MASKED IN AC JMP* XORB .EJECT / / DEPOSIT INTO FREE CORE AND INCREMENT FREE CORE POINTER / JMS DACFRE / POINTER /TV CONTAINING ADDRESS OF FREE CORE / /POINTER / AC RESTORED ON EXIT / DACTV 0 DACTMP 0 DACFRE 0 DAC DACTMP /SAVE AC LAC* DACFRE DAC DACTV /PERFORM 1 LEVEL OF INDIRECTION LAC* DACTV /PICK UP CONTENTS ISZ* DACTV /INCREMENT CONTENTS DAC DACTV /PERFORM ANOTHE LEVEL OF INDIRECTION TCA TAD* (.SCOM+3 /CHECK FOR OVERFLOW OF FREE CORE SMA JMP DACF1 /OK OVFLO1 JMS TERMER /ANNOUNCE TERMINAL ERROR .SIXBT 'NO CORE<@' DACF1 LAC DACTMP /PUT INTO TABLE DAC* DACTV ISZ DACFRE /BUMP TO EXIT JMP* DACFRE /EXIT .TITLE IMPORTANT VARIABLES AND CONSTANTS / / / SYSBL1 XX /BLOCK # OF SYSBLK IN SYSTEM COMBL1 XX /BLOCK # OF COMBLK IN SYSTEM SGNBL1 XX /BLOCK # OF SGNBLK IN SYSTEM SYSBL2 XX /BLOCK # OF DUMMY SYSBLK COMBL2 XX /BLOCK # OF DUMMY COMBLK SGNBL2 XX /BLOCK # OF DUMMY SGNBLK RKMFD 1777 /BLOCK # OF RK MASTER FILE DIRECTORY DPMFD 47040 /BLOCK # OF DP MASTER FILE DIRECTORY SATABP XX /POINTER TO LIST OF SAT BLOCKS IN /FREE CORE BTABP XX /POINTER TO SAT BLOCK LIST IN CORE(DUMMY) NOSATB XX /# OF SAT BLOCKS LITDEV XX /STORAGE FOR SYS DEV MNEMONIC SYHAN 0 /SYSTEM A HANDLER NAME ODATB 0 /HANDLER NAMES FOR OLD .DAT SLOTS TABLE /POINTER ODATE 0 /DELETED HANDLER NAME BEGINNING POINTER DELPT1 0 /ADDED OR DELETED SYS FILES SINCE /LAST REFRESHMENT OF SYBLK-COMBLK /TABLE POINTER CGEND 0 /END OF ABOVE TABLE ONPDAT 0 /OLD # OF POSITIVE .DAT SLOTS P2 0 /POINTER P3 0 /POINTER P4 0 /POINTER P5 0 /POINTER ALFA 0 /NEXT BLOCK # MCTR1 0 /COUNTER DECT1 0 /COUNTER SGNDAT 0 /POINTER TO .DAT SLOT TABLE IN /SGNBLK SGNSKP 0 /POINTER TO SKIP CHAIN TABLE IN /SGNBLK SGNUFD 0 /POINTER TO .UFD SLOT TABLE IN /SGNBLK TEMP 0 .EJECT / / .SIXBT CONSTANTS / LTTA .SIXBT 'TTA' LDONE .SIXBT 'DONE' A1 .SIXBT 'SPLGENDMP' LDP .SIXBT 'DP' LDK .SIXBT 'DK' LRK .SIXBT 'RK' L0A .SIXBT '0<@' LMT .SIXBT 'MT' LLP .SIXBT 'LP' LVT .SIXBT 'VT' LS80 .SIXBT '80' LS120 .SIXBT '120' LS132 .SIXBT '132' LUIC .SIXBT 'UIC' L0R .SIXBT '0>' LDKL .SIXBT 'DKL' LNONE .SIXBT 'NONE' /TABLE L16K .SIXBT '16K' L20K .SIXBT '20K' L24K .SIXBT '24K' L28K .SIXBT '28K' L32K .SIXBT '32K' /END OF TABLE LDOS15 .SIXBT 'DOS15' LALL .SIXBT 'ALL' .TITLE YES, NO, AND $ ANSWER ROUTINES / / THE YES NO TYPE OF QUESTION IN SPLGEN HAS BEEN DIVIDED UP INTO /5 ROUTINES FOR TYPING THE ENDING QUESTION MARK, THE DEFAULT ANSWER /IN PARENTHESIS, AND WAITING FOR THE REPLY. CARRIAGE RETURN /PRECEEDED ONLY BY SPACES MEANS TO ACCEPT THE DEFAULT ANSWER AS DOES /THE FACT THAT I/O SUPRESSION HAS BEEN PUT INTO AFFECT. A ALT MODE /ALONE ON A LINE OR PRECEEDED ONLY BY SPACES IS ECHOED AS '$' /AND SIGNIFIES THE ANTIDEFAULT CASE WHEN DEFINED FOR A YES NO /QUESTION. THIS DOES NOT NECESSARYILY AND USUALLY DOES NOT MEAN /A SIMPLE YES OR NO, BUT SIGNIFIES AN ALTERNATIVE PROCEEDURE TO /FOLLOW(Q.V. SPLGEN OPERATING MANUAL). MANY YES NO QUESTIONS /IN SPLGEN RESULT IN THE SETTING OF A BIT IN AN .SCOM REGISTER. TO /FACILITATE THIS TYPE OF OPERATION THE TWO SUBROUTINE ENTRIES /YW0 AND YW1 HAVE BEEN INSTITUTED. THE AC ON ENTRY CONTAINS THE /.SCOM WORD FROM THE SYSTEM BEING UPDATED, AND THE FIRST /ARGUMENT IS AN INSTRUCTION TO LOAD THE ACUMULATOR WITH A WORD /WITH ALL ZERO BITS ACCEPT THE BIT POSITION TO BE SET BY THE /QUESTION. ON EXIT THE NEW WORD TO BE PLACED IN THE .SCOM REGISTER /IS IN THE AC. THE ROUTINES PRINT '? (X) ' AND WAIT FOR AN ANSWER. /THE X STANDS FOR THE STATE OF THE SYSTEM AS INDICATED BY THE /AC ON ENTRY. IF I/O SUPRESSION EXISTS THE WORD WILL BE UNCHANGED /ON EXIT AND ALL I/O IS NATURALLY AVOIDED. TYPING AN $ IS BAD /SYNTAX IN THESE QUESTIONS AND RESULTS IN A LIST OF THE PROPER /RESPONES TO THE TELETYPE(CONSOLE) . THE FIRST EXIT IS TAKEN IN CASE /BAD SYNTAX IS FOUND. THE NEXT EXIT IF FOR A 'N' ANSWER AND /THE LAST FOR A 'Y' ANSWER. THE FOLLOWING IS AN EXAMPLE: / LAC SCOM4 /LOAD AC WITH WORD TO BE ALTERED / JMS YW0 /THE RESPONSE IS YES WHEN THE BIT IS 0 / LAC (1000 /THE BIT IS BIT 8 / JMP REPEAT /BAD SYNTAX CAUSES QUESTION TO BE REPEATED / JMP NO /ANSWER IS NO; AC CONTAINS NEW WORD / JMP YES /ANSWER IS YES; AC CONTAINS NEW WORD / / ABVIOUSLY IF A BIT IS NOT INVOLVED, THESE ROUTINES ARE NOT /OPTIMAL AND THE FOLLOWING ROUTINE ENTRIES ARE USED; / JMS YES /DEFAULT ENTRY IS YES / JMS NO /DEFAULT ENTRY IS NO / JMS ALTMOD /DEFAULT ENTRY IS $ / /THESE ROUTINES HAVE 4 EXITS INSTEAD OF 3. THE FOLLOWING IS AN EXAMPLE: / JMS YES /POWER OF POSITIVE THINKING / JMP REPEAT /BAD SYNTAX / JMP ALTMOD /TAKE ANTIDEFAULT ROUTE / JMP NO /ANSWER IS NO / JMP YES /ANSWER IS YES / / ALL THESE ROUTINES TAKE A COMPUTED EXIT WHEN THE ANSWER /IS CARRIAGE RETURN PRECEEDED ONLY BY SPACES; THEREFORE A DEFAULT /EXIT IS NOT EXPLICITLY GIVEN. THE ROUTINE ENTRY POINTS SHOW THE /DEFAULT EXIT PLAINLY AS ABOVE. THE ROUTINES PRINT THE DEFAULT /ANSWER EXACTLY AS DO THE 2 .SCOM BIT COMPUTATION ENTRIES. / YWTMPS XX /STATE WHEN YES YWTMP XX /BIT AFFECTED BY THE ROUTINES YWTMP1 XX /WORD TO BE CHANGED IF NECESSARY YW1 XX /YES WHEN ONE; YES WHEN BIT IS 1 ENTRY DAC YWTMP1 /STORE WORD TO BE CHANGED XCT* YW1 /PICK UP BIT TO BE CHANGED DAC YWTMPS /STORE THIS AWAY TOO LAC YW1 /PICK UP RETURN PC AND PUT INTO YW0 DAC YW0 JMP YW01 /JMP INTO ROUTINE YW0 XX /YES WHEN 0; YES WHEN BIT IS 0 DAC YWTMP1 /STORE ARGUMENT 1 DZM YWTMPS /0 WHEN YES YW01 XCT* YW0 /PICK UP BIT AFFECTED DAC YWTMP /STORE TEMPORARILY ISZ YW0 /BUMP TO BAD SYNTAX RETURN LAC SYNCON /OMIT ERROR MESSAGE ON BAD SYNTAX DAC SYNER /THIS EFFECTIVELY REMOVES THE ERROR /MESSAGE IN THE MORE BASIC ROUTINES /TO BE USED WHICH ACCEPT ALL ANSWERS LAC YWTMP /COMPUTE OLD STATE AND YWTMP1 SAD YWTMPS /IS DEFAULT ANSWER YES? JMP YWYES /YES! JMS NO /NO! JMP BADSY /BAD SYNTAX EVEN HERE JMP BADSY /EVEN ALT MODE IS BAD SYNTAX JMP ANNO /NO RETURN JMP ANYES /YES RETURN ANNO LAC YWTMP /COMPLEMENT STATE WHEN YES TO MAKE XOR YWTMPS /STATE WHEN NO DAC YWTMPS JMP ANNO1 /TAKE COMMON EXIT YWYES JMS YES /DEFAULT ANSWER IS YES JMP BADSY /BAD SYNTAX JMP BADSY /BAD SYNTAX ALSO JMP ANNO /NO ANYES ISZ YW0 /BUMP EXIT TO YES RETURN ANNO1 LAC YWTMP /MASK OFF OLD BIT CMA AND YWTMP1 XOR YWTMPS /PUT IN NEW ISZ YW0 /BUMP PAST BAD SYNTAX DAC YWTMP1 /SAVE JMP YW02 /GO TO EXIT BADSY JMS OUT /OUTPUT ERROR MESSAGE .SIXBT '_>@>(Y-N-C.R.)<@' YW02 LAC CRER /PUT BACK ERROR MESSAGE IN BASIC ROUTINE DAC SYNER LAC YWTMP1 /RESTORE ANSWER TO AC JMP* YW0 /EXIT ALTMOD 0 /BASIC ROUTINE WHEN ANSWER DEFAULT IS $ JMS OUT .SIXBT '? ($) <@' /PRINT DEFAULT ANSWER LAC ALTMOD DAC YES /STICK EXIT PC IN YES LAC (JMP YNALT /COMPUTED DEFAULT INSTRUCTION JMP YNENT /JMP INTO MIDDLE OF YES NO 0 /BASIC ROUTINE ENTRY WHEN DEFAULT IS NO JMS OUT .SIXBT '? (N) <@' /DEFAULT ANSWER IS NO LAC NO /STICK RETURN PC IN YES DAC YES LAC (JMP NO1 /ANSWER IS DEFAULT NO JMP YNENT /JMP INTO MIDDLE OF YES YES 0 /DEFAULT ANSWER IS YES JMS OUT /TYPE DEFAULT ANSWER .SIXBT '? (Y) <@' /DEFAULT ANSWER IS YES LAC (JMP YES1 /COMPUTED DEFAULT INSTRUCTION YNENT DAC YNDEF /STICK AWAY DEFAULT INSTRUCTION LAC YES /SYNTAX ERROR RETURN PC DAC BADSYN JMS IOSUP /I/O SUPPRESSION IN FORCE? JMP YNDEF /YES; TAKE DEFAULT ANSWER JMS BATCH /BATCH MODE? SKP /YES JMP YNNON1 /NO; READ IN IMAGE CLA /BATCH MODE READ WITH NO MORE ON LINE JMS ANS /ACCEPT ANSWER JMP SYNER /SYNTAX ERROR JMP YNDEF /DEFAULT ANSWER JMP YNALT /$ ANSWER SKP /SYMBOL IS ONLY OTHER LEGAL EXIT JMP SYNER /NUMBER IS BAD SYNTAX SAD (1 /# OF CHARACTERS MUST BE 1 SKP JMP SYNER /SYNTAX ERROR LAC ANSWER /TEST ANSWER SAD (310000 /Y? JMP YES1 SAD (160000 /N? JMP NO1 JMP SYNER /MUST BE Y OR N YNNON1 JMS TYIMG /READ IN IMAGE JMP SYNER /SYNTAX ERROR JMP YNDEF /DEFAULT (C.R.) JMP YNALT /ALT MODE $ JMP NO1 /NO YES1 ISZ YES /YES NO1 ISZ YES /NO YNALT ISZ YES /$ SYNCON JMP* YES /EXIT SYNER JMS OUT .SIXBT '_>@>(Y-N-$-C.R.)<@' /BAD SYNTAX JMP* BADSYN YNDEF XX /DEFAULT INSTRUCTION COMPUTED FROM ENTRY .EJECT / / SUBROUTINE TO READ TELETYPE IN IMAGE MODE IN ORDER TO SPEAD /UP USE OF SYSTEM GENERATOR IN NON BATCH MODE. LEADING SPACES WILL /BE IGNORED. / CALLING SEQUENCE / JMS TYIMG /ACCEPT ANSWER IN IMAGE / JMP REPEAT /REPEAT MESSAGE / JMP DEFAULT /DEFAULT ANSWER / JMP ALTMOD /ANTIDEFAULT ANSWER $ / JMP NO /NO / JMP YES /YES / TYIMG 0 TYI1 CAL 3776 /.READ -2 IN IMAGE .ASCII 10 TYIBUF -3 .WAIT -3 LAC TYIBUF+2 AND (177 /PICK UP FIRST CHARACTER SAD (40 /IS IT SPACE JMP TYI1 /YES; IGNORE SAD (116 /IS IT N? JMP TYIN /YES TAKE APPROPRIATE EXIT SAD (131 /IS IT Y? JMP TYIY /YES TAKE APPROPRIATE EXIT SAD (175 /IS IT ALT MODE? JMP TYDOL /YES TAKE APPROPRIATE ACTION SAD (44 /$ JMP TYDOL1 SAD (33 /ANOTHER LEGAL CODE FOR ALTMODE JMP TYDOL /TYPE $ SAD (176 /ANOTHER LEGAL CODE FOR ALTMODE JMP TYDOL /TYPE $ AND EXIT SAD (15 /CARRIAGE RETURN? JMP TYCR /TAKE DEFAULT EXIT SAD (137 /_ ISZ TYIMG JMS CRLF /NO; BAD SYNTAX; GIVE C.R. LF JMP* TYIMG /TAKE DBAD SYNTAX EXIT TYIY ISZ TYIMG TYIN ISZ TYIMG JMS CRLF /ECHO CRLF TO KEEP THINGS THE SAME TYDOL1 ISZ TYIMG /IN NON-BATCH MODE TYCR ISZ TYIMG JMP* TYIMG /EXIT TYDOL JMS OUT .SIXBT '$<@' /ECHO $ FOR ALTMODE JMP TYDOL1 .EJECT / / SUBROUTINE TO CHECK WHETHER IN BATCH MODE / JMS BATCH / JMP YES / JMP NO / BAT1 0 BATCH XX DAC BAT1 /SAVE AND RESTORE AC LAC 17777 SMA ISZ BATCH /SKIP IF NONBATCH MODE LAC BAT1 JMP* BATCH /EXIT WITH AC RESTORED .TITLE FETCH ANSWER ROUTINE / / FETCH ANSWER HAS 3 ENTRY POINTS (ANS,MULANS,MORANS). /A ZERO AC FILTERS OUT ANSWERS WHICH DO NOT CONSIST OF A /SYLABLE ENDING WITH CARRIAGE RETURN OR ALTMODE /OTHER TERMINATORS ARE '<','>','/',',','=', AND SPACE. /THE TERMINATOR IN .ASCII WILL BE STORED IN OP. THE ANSWER WILL BE /STORED AS 6 .SIXBT CHARACTER PADDED WITH @ INTO ANSWER AND /ANSWER +1. AN OCTAL NUMBER WILL BE STORED INTO NUMBER. A MINUS /SIGN ENCOUNTERED ANYWHERE IN AN OCTAL NUMBER WILL NEGATE THE /NUMBER (2'S COMPLEMENT). A + SIGN IN A NUMBER WILL BE IGNORED. /IF THE ANSWER IS AN OCTAL NUMBER, THE CONTENTS OF ANSWER AND /ANSWER+1 SHOULD BE IGNORED. IF THE ANSWER IS A ALT MODE /PRECEEDED BY 0 OR MORE SPACES, A $ WILL BE ECHOED ON THE TELETYPE /AND A SPECIAL EXIT TAKEN. $ ITSELF IS EQUIVALENT TO ALT MODE /ITSELF IN ORDER TO AVOID CONFUSION. IF THE ANSWER IS A CARRIAGE RETURN /OR _ PRECEEDED ONLY BY 0 OR MORE SPACES THEN A SPECIAL EXIT IS TAKEN /(THE DEFAULT EXIT). IF THE ANSWER IS NOT A LEGAL OCTAL /NUMBER, THE SYMBOL EXIT WILL BE TAKEN. IF THE ANSWER IS A LEGAL /OCTAL NUMBER, THE NUMBER EXIT WILL BE TAKEN. THE ROUTINE CHECKS /FOR ANSWERS THAT ARE TOO LONG OR WHICH CONTAIN ILLEGAL .ASCII /CHARACTERS AND OUTPUTS AN APPROPRIATE MESSAGE. ALL BAD SYNTAX /ERRORS TAKE THE SAME EXIT. MULANS IS USED TO FETCH THE NEXT /ANSWER IN A MULTILINE ANSWER SEQUENCE. MORANS IS USED /TO FETCH THE NEXT ANSER ON THE SAME INPUT LINE. ALL INPUT IS IN /IOPS .ASCII. IF NO MORE INPUT IS PRESENT ON THE LINE, MORANS TAKE /THE BAD SYNTAX EXIT OR $ EXIT OR DEFAULT EXIT. THE AC ON A SYMBOL /EXIT CONTAINS THE NUMBER OF NON-NULL CHARACTERS IN THE SYMBOLIC ANSWER /THE AC ON OCTAL NUMBER EXIT CONTAINS THE OCTAL NUMBER. IF /NEGFLG IS NON-ZERO, THE NUMBER INPUT CONTAINED A MINUS SIGN. THE /NUMBER OF DIGITS INPUT IS STORED IN CNTDIG. THE NUMBER OF CHARACTERS /IN A SYMBOLIC ANSWER IS CONTAINED IN CNTCHR. NUMFLG IS ZERO, IF /THE INPUT WAS AN OCTAL NUMBER. / CALLING SEQUENCE: / CLC /OR CLA; CLA TO LOCK OUT TERMINATORS / /INDICATING MORE ON LINE / JMS ANS /OR MULANS OR MORANS / JMP QUES /BAD SYNTAX / JMP DEFALT /DEFAULT ANSWER / JMP ALTMOD /ANTIDEFAULT ANSWER / JMP SYMBOL /SYMBOLIC ANSWER / JMP NUMBR /OCTAL NUMBER ANSWER / ANS 0 DAC OPFLG /STORE FLAG INDICATING MORE ON LINE LAC ANS JMP ANSENT /JMP INTO ROUTINE MULANS 0 /ENTRY INDICATING MULTILINE SEQUENCE DAC OPFLGS /STORE INTO TEMPORARY FOR MORE ON LINE MULBAD JMS OUT /OUTPUT GO AHEAD .SIXBT '_>@>><@' LAC OPFLGS /PUT MORE ON LINE FLAG INTO SAVE REGISTER DAC OPFLG LAC MULANS /GET RETURN PC ANSENT DAC ANS /STORE RETURN PC INTO ANS DAC BADSYN /FIRST EXIT IS BAD SYNTAX ISZ ANS /BUMP PAST BAD SYNTAX JMS IOSUP /I/O SUPPRESSION? JMP* ANS /YES; TAKE DEFAULT EXIT LAC (TYIBUF+2 /UNPACK ANSWER DAC ANSP1 CAL 2776 /.READ -2 IN IOPS .ASCII 10 TYIBUF -46 .WAIT -2 LAW -1 /SET UP TO START UNPACKING FROM DAC KLGET5 /THE BEGINNING JMP MULSKP MORANS 0 /ENTRY POINT TO BEGIN UNPACKING DAC OPFLG /FROM WHERE LEFT OFF ON LINE LAC MORANS /STICK RETURN PC INTO ANS DAC ANS DAC BADSYN /BAD SYNTAX EXIT ISZ ANS /BUMP TO DEFAULT EXIT JMS IOSUP /I/O SUPRESSION? HLT /THIS PART OF SPLGEN SHOULD NEVER BE REACHED LAC OP SNA /IS THERE MORE ON LINE JMP* BADSYN /NO; BAD SYNTAX MULSKP DZM CNTCHR /# OF CHARACTERS SET ORIGINALLY TO 0 DZM CNTDIG /# OF OCTAL DIGITS ALSO DZM NEGFLG /# NOT NEGATED DZM NUMBER /# ORIGINALLY 0 DZM NUMFLG /# IS A NUMBER TO START WITH DZM OP / OPERATOR IS CARRIAGE RETURN OR ALT MODE /UNLESS FOUND TO THE CONTRARY DZM ANSWER /ANSWER IS ORIGINALLY NOT THERE DZM ANSWER+1 /ALSO SECOND HALF LAC (ANSWER /SET UP TO GET FIRST HALF OF ANSWER DAC ANS1 ANS2 LAW -3 /ANSWER IS TO BE PACKED IN .SIXBT DAC SIXTMP /SET UP TO PUT IN FIRST CHARACTER ANS17 ISZ KLGET5 /IS THIS THE BEGINNING OF A 5/7 PAIR JMP KL5GET /NO; UNPACK ANOTHER LAC* ANSP1 /GET NEXT PAIR DAC KLWD1 ISZ ANSP1 LAC* ANSP1 DAC KLWD2 ISZ ANSP1 LAW -5 /SET UP TO UNPCK ANOTHER FIVE DAC KLGET5 KL5GET LAW -10 /SHIFT WORD PAIR 7 TIMES DAC KLWD3 KL6GET LAC KLWD2 /STANDARD UNPACKING ROUTINE RAL ISZ KLWD3 SKP JMP KL6G1 DAC KLWD2 LAC KLWD1 RAL DAC KLWD1 JMP KL6GET KL6G1 AND (177 /CLEAN DAC KLWD4 /SAVE AND (170 /LEGAL OCTAL DIGIT SAD (60 SKP /YES JMP KL6G2 /NO ISZ CNTDIG /COUNT DIGITS IN NUMBER LAC NUMBER /MULTIPLY PREVIOUS VALUE BY 8 RCL RTL XOR KLWD4 /MERGE DIGIT INTO LAST POSITION AND (777770 XOR KLWD4 DAC NUMBER JMP ANS3 /GO PUT INTO SYMBOL ALSO JUST IN CASE KL6G2 LAC KLWD4 /TEST FOR SPECIAL CHARACTER SAD (55 /-? JMP ANS7 /YES NEGATE NUMBER SAD (40 /SPACE JMP ANS16S /YES; IGNORE IF LEADING SAD (137 /_ JMP ANS40 SAD (74 // JMP ANS16G SAD (54 /,? JMP ANS16 SAD (53 /+? JMP ANS3 SAD (175 /ALTMODE JMP ANS8 SAD (15 /C.R.? JMP ANS9R SAD (75 /=? JMP ANS16 SAD (57 /'/'? JMP ANS16 SAD (44 /$ JMP ANS99 ANS100 ISZ NUMFLG AND (77 DAC KLCNTB /COMPUTE IF CHARACTER IS LEGAL IN .SIXBT AND (40 SNA!STL CLL LAC KLCNTB SNL!SZA XOR (100 SAD KLWD4 JMP ANS3 /LEGAL CRER JMS OUT /ILLEGAL .SIXBT '>@>(NON-PRINTING CHAR)<@' JMP* BADSYN /BAD SYNTAX ANS7 ISZ NEGFLG /SET NEGATE FLAG ANS3 LAC KLWD4 /GET CHARACTER AND (77 /STRIP TO .SIXBT ISZ CNTCHR /COUNT CHARACTERS IN SYMBOL ISZ SIXTMP /DETERMINE WHETHER SYMBOL IS FIRST JMP ANS4 /SECOND OR THIRD IN .SIXBT WORD XOR* ANS1 /THIRD DAC* ANS1 /STORE AWAY ISZ ANS1 /START WITH NEXT WORD JMP ANS2 /GO FOR MORE ANS4 ISZ SIXTMP /TEST AGAIN JMP ANS12 /LAST CHARACTER CLL RTL /SECOND CHARACTER RTL RTL XOR* ANS1 DAC* ANS1 LAW -1 /LAST CHARACTER NEXT JMP ANS2+1 ANS12 LAC CNTCHR /FIRST CHARACTER; TEST WHETHER LEGAL TAD (-7 /IS THE NUMBER OF CHARACTERS 7 SMA JMP ANS2 /YES; IGNORE FURTHER CHARACTERS LAC KLWD4 /PICK UP CHARACTER AND (77 /CLEAN TO .SIXBT RCR RTR RTR RTR DAC* ANS1 /FIRST WORD IGNORES PREVIOUS CONTENTS LAW -2 JMP ANS2+1 /SECOND CHARACTER NEXT ANS16 DAC OP /STORE OPERATOR OR DELIMITER AND (77 /CLEAN OFF TO .SIXBT ANS16I DAC OP1 /STORE IN BAD OPERATOR MESSAGE ANS16T LAC OPFLG /TEST IF THIS KIND OF DELIMITER SZA /IS GOOD SYNTAX HERE JMP ANS9 /YES OPBAD JMS OUT /BAD DELIMITER .SIXBT '>@>("' OP1 XX .SIXBT '" IS BAD DELIMITER)<@' JMP* BADSYN /BAD SYNTAX ANS16L DAC OP /SPECIAL DELIMITERS IN THAT THEY LAC LESTH /MUST BE DOUBLED IN ORDER TO PRINT JMP ANS16I ANS16G DAC OP LAC GRTH JMP ANS16I LESTH .SIXBT '<<' GRTH .SIXBT '>>' LSALT .SIXBT 'ALT' LSCRT .SIXBT 'CR' ANS8 LAC CNTCHR /IS ALT MODE ALONE? SNA JMP ANS10 /YES; ECHO $ AND TAKE $ EXIT JMS CRLF /GIVE CARRIAGE RETURN LINE FEED LAC LSALT /INDICATE ALT MODE AS DELIMITER SKP ANS9CR LAC LSCRT /INDICATE CARRIAGE RETURN AS DELIMITER DAC OP1 ANS9 LAC NUMFLG /EXIT; IS THE NUMBER LEGAL SNA JMP ANSNM1 /YES ANSYM LAC CNTCHR /SYMBOL TOO LARGE? TAD (-7 SPA JMP ANSSOK /NO JMS OUT /SYMBOL TOO LARGE .SIXBT '>@>(SYMBOL >> 6 CHAR)<@' JMP* BADSYN /BAD SYNTAX ANS99 LAC CNTCHR /HAVE ANY CHARACTERS PRECEEDED SNA JMP ANS15 /NO; TREAT LIKE DEFAULT LAC KLWD4 /YES JMP ANS100 ANSSOK LAC ANSWER /CHECK FOR DONE SAD LDONE /(.SIXBT 'DONE' SKP JMP ANSOK7 /NO MATCH LAC ANSWER+1 /SECOND WORD SAD LDONE+1 JMP* ANS /MATCH; DEFAULT EXIT ANSOK7 LAC CNTCHR /PUT # OF CHARACTERS IN AC ANSOK1 ISZ ANS /BUMP FOR SYMBOL EXIT ANS15 ISZ ANS /BUMP FOR $ ANSWER JMP* ANS /EXIT ANSNM1 LAC CNTDIG /ARE DIGITS ENOUGH SNA JMP ANSYM /NO; MUST BE SYMBOL TAD (-7 /TOO MANY DIGITS SPA JMP ANSNOK /NO; EXIT JMS OUT /YES .SIXBT '>@>(# >> 6 DIGITS)<@' JMP* BADSYN /BAD SYNTAX ANSNOK LAC NEGFLG /IS NUMBER TO BE NEGATED SNA /SKIP IF # NEGATIVE JMP ANSNK1 /NUMBER NOT PRECEEDED BY MINUS SIGN LAC NUMBER /FORM TWO'S COMPLEMENT OF NUMBER TCA DAC NUMBER /AND STORE BACK IN NUMBER ANSNK1 LAC NUMBER /PUT # IN AC ON EXIT ISZ ANS /BUMP TO NUMBER RETURN JMP ANSOK1 ANS10 JMS OUT /ALT MODE ALONE; ECHO $ .SIXBT '$<@' JMP ANS15 ANS40 LAC CNTCHR /IF ALONE INDICATES DEFAULT SNA JMP* ANS /DEFAULT EXIT LAC LAR DAC OP1 JMP OPBAD /BAD OPERATOR LAR .SIXBT '__' ANS16S DAC OP /STORE AWAY OPERATOR DAC OP1 LAC CNTCHR /IGNORE LEADING SPACES SZA JMP ANS16T DZM OP JMP ANS17 /SPACES ARE NOT OPERATORS WHEN LEADING ANS9R LAC CNTCHR /CARRIAGE RETURN IS DEFAULT ONLY SZA /WHEN ALONE JMP ANS9CR /NOT ALONE; PROCESS AS USUAL JMP* ANS /TAKE DEFAULT EXIT SYMBAD JMS RERR /ANNOUNCE RECOVERABLE ERROR .SIXBT "ISN'T OCTAL #<@" NUMBAD JMS RERR /ANNOUNCE RECOVERABLE ERROR .SIXBT "ISN'T SYMBOL<@" ALTBAD JMS OUT /ALT MODE NONACCEPTABLE ANSWER .SIXBT '_>@>("$" BAD HERE)<@' JMP* BADSYN /BAD SYNTAX CRBAD JMS OUT /DEFAULT CASE IS ILLEGAL .SIXBT '>@>(NO DEFAULT CASE)<@' JMP* BADSYN /BAD SYNTAX SDER JMS TERMER /ANNOUNCE FATAL SOFTWARE DIRECTIVE TCB ERROR .SIXBT '>FATAL TCB ERROR ON SOFTWARE DIRECTIVE<@' SAMERK JMS TERMER /ANNOUNCE ATTEMPT TO ALTER SPOOLER AREA /ON SAME DISK AS ONE IN CURRENT USE BY SPOOLER .SIXBT '>ERROR - SPOOLER ENABLED ON SELECTED UNIT<@' NOTCB JMS TERMER /ANNOUNCE NO TCB FOR PIREX /SPLGEN USE .SIXBT '>FATAL ERROR - DOS LACKS TCB AREA FOR SPLGEN USE<@' BRANGE JMS RERR /ANNOUNCE AREA ILLEGAL SIZE ERROR AND RETRY .SIXBT 'BLOCKS NOT WITHIN LEGAL RANGE [ 0 OR 77<FATAL SAT. BLOCK ALLOCATION ERROR<@' .TITLE SMALL SUBROUTINES / / ROUTINE TO CHECK THAT # IN AC CORRESPONDS TO LEGAL .DAT SLOT / JMS LEGAL / JMP NO / JMP YES /LEGAL / / / SUPPRESS SEGMENT / JMS SUPSEG / SUPSEG XX LAC (NOP DAC IOSEG JMP* SUPSEG / / SUPPRESS SECTION / JMS SUPSEC / SUPSEC XX LAC (NOP DAC IOSEC JMP* SUPSEC .EJECT / / START NEW SECTION AND SET ^P / JMS SECTN / .SIXBT 'MESSAGE<@' / SECTN XX JMS RIOSUP /REMOVE ALL I/O SUPRESSION LAW -1 /COMPUTE ^P ADDRESS TAD SECTN AND (77777 DAC CNTLP JMS CRLF /.INIT -3 JMS CRLF JMS OUTP /TYPE MESSAGE LAC SECTN JMP* OUT /EXIT RIGHT AFTER MESSAGE / / ASK QUESTION OR MAKE STATEMENT / JMS QUERY / .SIXBT 'MESSAGE<@' / QUERY XX JMS OUT .SIXBT '_><@' JMS OUTP LAC QUERY JMP* OUT /EXIT RIGHT AFTER MESSAGE / / SAVE CONTENTS OF ANSWER TEMPORARILY / JMS SAVANS / ANSTMP 0 /ANSWER SAVED HERE 0 SAVANS XX LAC ANSWER DAC ANSTMP LAC ANSWER+1 DAC ANSTMP+1 JMP* SAVANS .EJECT / / / SUBROUTINE TO PRINT SYMBOL IN ANSWER / JMS PANS / PANS 0 JMS OUT .SIXBT '>@>("' ANSWER 0 0 .SIXBT '" <@' JMP* PANS .EJECT / / SUBROUTINE TO PRINT NUMBER / NUMBER 0 PNUM 0 JMS OUT .SIXBT '>@>("<@' LAC NEGFLG /WAS THE NUMBER NEGATED ON INPUT SNA JMP PNUM1 /NO; DO NOT OUTPUT EVER AS NEGATIVE LAC NUMBER /YES; IS NUMBER NEGATIVE? SPA JMP PNUM2 /YES; OUTPUT AS SIGNED NEGATIVE # LAW 55 /NO; OUTPUT AS POSITIVE # PRECEEDED JMS KLPUT /BY MINUS SIGN LAC NUMBER TCA JMP PNUM3 PNUM1 LAC NUMBER /IS # NEGATIVE NOW SMA JMP PNUM3 /NO; OUTPUT WITH ZERO SUPRESSION JMS NUMOUT /YES; OUTPUT WITHOUT ZERO SUPRESSION SKP PNUM2 JMS SOCT /OUTPUT AS SIGNED OCTAL # WITH ZERO SUP SKP PNUM3 JMS NUMSUP JMS OUT .SIXBT '" <@' JMP* PNUM .EJECT / / TEMPORARY STORAGE / P1 0 /TEMP. LOC. KLGET5 0 KLWD1 0 KLWD2 0 KLWD3 0 KLWD4 0 OP 0 /CURRENT OPERATOR IN EXPRESSION ANS1 0 /POINTER TO WORD IN ANSWER RECEIVING CHARACTERS NEGFLG 0 /0 WHEN # BEING ACCUMULATED WAS NOT PRECEEDED /BY A MINUS SIGN NUMFLG 0 /0 WHEN SYLABLE CURRENTLY BEING FORMED IS OCTAL # OPFLG 0 /0 WHEN CURRENT SYLABLE MUST END WITH CAR. RET. /OR ALT MODE OPFLGS 0 /TEMPORARY STORAGE OF OPFLG IN MULTILINE SEQUENCE BADSYN 0 /CONTAINS PC FOR BAD SYNTAX RETURNS FROM ANSWER /ROUTINES ANSP1 0 CNTCHR 0 /ACCUMULATOR FOR # OF CHARACTERS IN SYLLABLE CNTDIG 0 /ACCUMULATOR FOR # OF OCTAL DIGITS IN # SIXTMP 0 /COUNTER SAVAC 0 /SAVE LOCATION FOR AC / / SUBROUTINE TO GIVE A CARRIAGE RETURN LINE FEED ON TELETYPE /IF I/O SUPRESSION IS NOT IN FORCE / CRLF XX JMS IOSUP JMP* CRLF /EXIT IF I/O SUPRESSION CAL 775 /.INIT -3 1 CNTLP XX /CONTROL P ADDRESS 0 .WAIT -3 JMP* CRLF .EJECT / / SUBROUTINE TO CHECK FOR I/O SUPRESSION. AC,L NOT TOUCHED / JMS IOSUP / IOSUP XX IOSEG SKP /NOP IF SUPRESSION ON A SEGMENT JMP* IOSUP IOSEC SKP /NOP IF SUPRESSION ON A SECTION BASIS JMP* IOSUP ISZ IOSUP JMP* IOSUP / / / TERMINAL ERROR ROUTINE / TERMER 0 JMS RIOSUP /LIFT I/O SUPRESSION ON TERMINAL ERROR JMS OUTP /OUTPUT ERROR MESSAGE ARGUMENT LAC TERMER /POINTED TO BY ROUTINE JMS OUT .SIXBT ' - ABORT_<@' ENDGEN .INIT -14,0,0 .FSTAT -14,A1 SNA JMP TERM1 /FILE NOT PRESENT .DLETE -14,A1 TERM1 .EXIT .EJECT / / RECOVERABLE ERROR / JMS RERR / .SIXBT 'MESSAGE<@' / RERR 0 LAC NUMFLG /IS IT # SNA JMP .+3 /YES; NUMBER JMS PANS /SYMBOL SKP JMS PNUM JMS OUTP /PRINT ERROR MESSAGE LAC RERR JMS OUT /PRINT ENDING .SIXBT ')<@' JMP* BADSYN /GO BACK TO SYNTAX EXIT / REMOVE I/O SUPRESSION / RIOSUP 0 LAC (SKP DAC IOSEG DAC IOSEC JMP* RIOSUP / / / SUBROUTINE TO MOVE TCB FROM SPLGEN TO DOS MONITOR TCB AREA / CALL SEQUENCE: / LAC (XXXX /WHERE XXXX IS TCB ADR. / DAC TASK / LAW -NNN /WHERE NNN IS THE SIZE OF THE TCB / JMS MOVTCB / / / RETURN IS TO LOCATION FOLLOWING JMS MOVTCB / / MOVTCB 0 /ENTRY POINT DAC SIZ# /SAVE -SIZE LAC TCB /GET DOS RK TCB SLOT ADR. DAC TCBX# /SAVE IT IN A TEMP LAC TASK /GET START OF TCB TO BE MOVED DAC TASKX# /SAVE IT IN A TEMP LOOPMV LAC* TASKX /GET ITEM DAC* TCBX /MOVE IT ISZ TASKX /INC. POINTER ISZ TCBX /INC. POINTER ISZ SIZ /DONE YET? JMP LOOPMV /NO JMP* MOVTCB /YES - RETURN TO CALLER / / / SUBROUTINE TO SEND TCB TO UC15 PIREX SYSTEM / CALL SEQUENCE: / JMS TCBIO / / / RETURN IS TO LOCATION FOLLOWING JMS TCBIO IF AN ERROR IS DETECTED / / RETURN IS TO LOCATION+1 FOLLOWING JMS TCBIO IF NO ERROR OCCURS / / TCBIO 0 /ENTRY POINT TCBIO1 DZM* EV /CLEAR THE EVENT VARIABLE LAC TCB /GET THE ADR. OF THE DOS RK TCB AREA LOOPTC SIOA /IS THE UC15 BUSY? JMP LOOPTC /YES - KEEP TRYING LIOR /NO - SEND ADR. OF TCB TO PIREX LOOPTB LAC* EV /GET THE EVENT VARIABLE SNA /HAS IT BEEN SET BY PIREX YET? JMP LOOPTB /NO - KEEP LOOKING SAD (177001 /TEST FOR PIREX TEMP. OUT OF NODE CONDITION JMP TCBIO1 /OUT OF NODES OCCURED - TRY AGAIN AND (100000 /SET UP TEST FOR ERROR EV SZA /SKIP IF NO ERROR JMP* TCBIO /RETURN AT ERROR EXIT ISZ TCBIO /INC. RETURN TO GOOD EXIT JMP* TCBIO /RETURN AT OK EXIT / / .TITLE TCB'S / / / TCBS FOR PIREX CONTROL / / / TCB FOR SPOOLER INFORMATION / SPTCB 0 /NO API 601 /NO INT. 0 /EV 2000 /ASK FOR SPOOLER INFO 0 /SPLSW 0 /DEVARE 0 /DEVSPL 0 /SPUNIT / / / RKTCB 0 /NO API 602 /NO INT. 0 /EV RBLKN 0 /BLOCK NUMBER RKMSA 0 /REL+MSA RKLSA 0 /LSA -400 /WORD COUNT RFCN 2 /UNIT,FUNCTION (DEFAULT READ) 0 /RKCS 0 /RKER 0 /RKDS / / / .TITLE BUFFERS .LTORG PATCH .BLOCK 50 /PATCH AREA TYOBUF 23000 /OUTPUT BUFFER 0 TYIBUF=.+44 COMBLK=TYIBUF+1047 /OFFSET VARIABLE POINTER ENDCOM=COMBLK .TITLE SAT / / THIS IS THE BUFFER FOR THE STORAGE ALLOCATION TABLE / SAT=TYIBUF+1050 SATND=SAT+400 /SATND SHOULD EQUAL 17637 .IFDEF BIN .LOC SATND .ENDC / .END START