/ MULTI SECTION 2 V 0.88 / BEGIN SECTION 2 LISTING CONTROL IFNZRO LIST&4 FIELD 1 *0 PCDF, CDF 00 IFNZRO PCDF <^^^ ERROR IN POPDSZ, K10B ^^^> ZPTRST, PTRSET ZPUSHJ, PUSHJX XRDOIO, RDOIO XCDOIO, CDOIO XOTOPD, OTOPD MOVE, XMOVE KGPBUF, GPBUF *10 XRM0, 0 XRM1, 0 XRM2, 0 XRM3, 0 XRM4, 0 XR, 0 XR1, 0 XR2, 0 RSCDF, CDF RSFLD ZILOOP, ILOOP ZFAKNUM, FAKNUM ZDES2, DES2-1 ZFETPC, FETPC ZUSRCF, USRCF ZJOBIX, JOBIDX ZWXIDX, WXIDX WXI, 0 SPLDEV, 0 /GETS FILLED IN WITH ADDRESS OF $LPTSP DEVICE HANDLER PROCN, 0 / - MAX # BUFFERS -1 ALAST, ACA+DIGITS-1 NUMLEN, -DIGITS /LENGTH OF DECIMAL WORK AREAS PUSHS= JMS I .; PUSHX POPS= JMS I .; POPSTK POPNUM= JMS I .; POPNMX POPLFT= JMS I .; POPLFX POPDES= JMS I .; POPDSX POPDS1= JMS I .; POPD1X DBCONV= JMS I .; DBCNVX FATAL= JMS I .; FATALX ERROR= JMS I .; ERRORX GETCH1= JMS I .; GETC1X GETCH2= JMS I .; GETC2X /GETCH2 MUST BE AT GETCH1+1 PUTCHI= JMS I .; PUTCHX PUSHJS= JMS I .; F1PSHJ POPJS= JMP I .; F1POPJ BSWN= JMS I .; BSWX P7, 7 P10, 10 P17, 17 P21, 21 P70, 70 P77, 77 P200, 200 /PUT HERE BECAUSE OF FEEBILITY P237, 237 P7400, 7400 P7600, 7600 M10, P7770, 7770 M1, -1 M4, -4 *105 SWPBEG=. SEGSUM, 0 /USED BY LPTSPL CHRPTR, 0 /USED BY LPTSPL LPTLO, 0 /KEEP LPTCTL, 0 /THESE LPTADR, 0 /FOUR LPTHI, 0 /TOGETHER! USRBAS, 0 USRFLD, 0 /CONTAINS CDF TO JOB BASE ADDR TIFN, 0 IFN, 1 /PHONEY FILE FOR THE LOADER U0, DSKQ U1, 0 U2, 0 WX, SYSPFT-1 /CONTAINS LINK TO LOGICAL UNITS TABLE ENTRY W0, 0200 W1, LPTBUF&7600+0 W2, LPTBUF+15 W3, -400+16 W4, 0 W5, 0 OLDPDL, 0 /PDL AT BEGINNING OF CURRENT STMT GETPNT, 0 PUTPNT, 0 USRERR, 0 /LOC OF USER ERROR ROUTINE (IF ANY) COUNT, 0 SYGET, MSBT+1 PC, 0 /PROGRAM COUNTER PCFLD, 0 /PROGRAM FIELD T, 0 /TEMPORARY T1, 0 /" LFCTR, /USED BY "FORMS" TO COUNT LINEFEEDS T2, 0 /" RTIFN, /SHARED BY RDOIO IST1, 0 /HOLDS ADDRESS FIELD DESCRIPTOR REELNO, /SHARED BY MOUNT IST2, 0 /" PDL, PDLBEG /PUSHDOWN LIST POINTER LENGTH, LDBUF DES1= . /DEFINITION OF DESCRIPTOR 1 DES1L, 0 /LENGTH DES1W, 0 /WORD DES1B, 0 /BYTE DES1F, CDF RSFLD /CDF LOCATION DES2= . /DEFINITION OF DESCRIPTOR 2 DES2L, 0 /LENGTH DES2W, 0 /WORD DES2B, 0 /BYTE DES2F, CDF RSFLD /CDF LOCATION PUTDES= . /DEFINITION OF DESCRIPTOR 3 ( "PUT" DESCRIPTOR) PUTDL, 0 /LENGTH PUTDW, 0 /WORD PUTDB, 0 /BYTE PUTDF, CDF RSFLD /CDF LOCATION KILCTR, /TEMP USED BY KILLIT TERMNI, /TEMP USED BY LOADER LINENO, 0 /SOURCE LINE NUMBER KILPTR, /SHARED BY KILLIT STCTR, /SHARED BY LOGOUT TRCJMP, 0 /0 OR "JMP I PUTCHX" CMPCNT, CTRLO, /!!!!*****!!!! GTDTMP, /SHARED BY LOADER RELBHI, 0 /HIGH ORDER BLOCK # FOR RANDOM ACCESS LBLLOC, /SHARED BY MOUNT RELBLO, 0 / LOW ORDER " RDOARG, /SHARED BY RDOIO BLKSIZ, 0 /(DIBOL) BLOCK SIZE FOR R.A. RCLKCT, /TEMP USED BY RECORD LOCK NLCTR, /TEMP USED BY LOADER BUFSIZ, 0 /BUFFER SIZE FOR R.A. TRCFLG, 0 /TRACE FLAG A, ACA /DEFINITION OF ACCUMULATOR A RAT1, /USED AS TEMP BY RANDOM ACCESS AS, 0 B, ACB /DEFINITION OF ACCUMULATOR B IFNZRO B-A-2 <^^^ ERROR ^^^> BS, 0 ZMT1, /SHARED BY MOUNT QDIGIT, 0 /TEMPORARY FOR MULTIPLY AND DIVIDE / DO NOT ADD HERE WITHOUT CHANGING ORIGIN AT SWPBEG PAGE SWPEND=. /RSYS LOADER - LOADS OUTPUT OF DIBOL COMPILER PDLBEG, ZBLOCK 20 / / RLOOP, TAD (11 JMS I XRDOIO /READ AN INPUT LINE LDBUF-1 EOFERR, FATAL /END OF FILE SEEN PREMATURELY - ERROR TAD (LDBUF DCA XR TAD I XR /GET TYPE OF LINE TAD RJUMP DCA RTMP TAD XR DCA GTDTMP CDF 00 TAD I (NJOBS DCA NLCTR TAD (BASTBL-1 DCA XRM0 NLOOP, CDF 00 TAD I XRM0 DCA USRFLD TAD I XRM0 DCA USRBAS CDF RSFLD RTMP, HLT /JUMP TO PROPER ROUTINE RJUMP, JMP I .+1 PROG /PROGRAM INTERPRETIVE CODE DATCLA /DATA CLEAR - ALPHA DATCLD /DATA CLEAR - DECIMAL SYMHDR /SYMBOL TABLE HEADER DATASK /DATA TO BE SPECIFIED AT LOAD TIME MORDAT, DATFAK /DUMMY ENTRY FOR MULTIPLE DATA READS XXX / FREE DATSET /DATA INITIALIZATION DATDAT /INSERT CURRENT DATE DCLRCH /CLEAR DECIMAL FIELD IF NOT A CHAIN OPTSET /OPTION INITIALIZATION COMMAT /TERMINAL NUMBER INITIALIZATION COMMTC /DUMMY ENTRY FOR OPTION /T PROGLP, ISZ T1 JMP PROGXX TAD PRGCDF TAD P10 DCA PRGCDF PROGXX, TAD I XR /GET A WORD PRGCDF, HLT DCA I T1 /STORE IT INTO THE PROGRAM AREA CDF RSFLD PROG, ISZ I (LDBUF JMP PROGLP JMP RLOOP /GET NEXT INPUT LINE GTDESC, 0 TAD GTDTMP DCA XR TAD I XR PUSHS TAD I XR PUSHS /STACK THE DESCRIPTOR TAD (PUTDES-1 POPDES /UNSTACK AND EXPAND IT JMP I GTDESC /EXIT WITH CDF IN AC DATSM1, STA /TURN "GETCH2" TO "GETCH1" DATSET, TAD (GETCH2 DATSTX, DCA DATGET /STORE EITHER "TAD T", "GETCH2", OR "GETCH1" JMS GTDESC /AGAIN, THE FIRST TWO WORDS ARE A DESCRIPTOR SRDIES, CLA IAC TAD XR DCA DES2W /SET UP DESCRIPTOR 2 JUST IN CASE AC7776 /WE'RE USING GETCH2 DCA DES2B DATGET, HLT /GET THE CHARACTER ONE WAY OR THE OTHER SZA JMP DATPUT /NON-ZERO MEANS ITS GOOD TAD (CLA IAC /OTHERWISE FILL WITH BLANKS DCA DATGET JMP DATGET DATPUT, PUTCHI /MOVE CHARACTERS FROM SOURCE TO DESTINATION ISZ PUTDL JMP DATGET /THE APPROPRIATE NUMBER OF TIMES DATCON, ISZ NLCTR JMP NLOOP JMP RLOOP COMMTC, JMS GTDESC COMMTL, TAD PUTDL CMA /TEST FOR LAST CHAR IN VARIABLE SNA CLA JMS I (TERMNL /IS LAST CHARACTER, GET TERMINAL # TAD P21 /MAKE COSCII PUTCHI ISZ PUTDL JMP COMMTL JMP DATCON TAD21= TAD P21 /PAL8 HAS NO PARENTHESES! DATCLD, TAD (TAD21-7201 /DIFF BET "TAD [21" AND "CLA IAC" DATCLA, TAD SRDIES /TAD (CLA IAC DCA DATGET /KLUDGE TO HANDLE CLEARS JMS GTDESC /LONGER THAN 512 CHARACTERS TAD I XR DCA PUTDL JMP SRDIES / PAGE /DATA INITIALIZATION LOAD ROUTINES DATASK, TAD I XR DCA NM1 /THE CONTENTS OF THIS LINE IS THE NAME OF THE TAD I XR DCA NM2 /VARIABLE TO ASK FOR AND ITS DESCRIPTOR TAD I XR DCA NM3 TAD (11 JMS I XCDOIO ENTERM-1 /AN "ENTER NAME" MESSAGE NOP TAD P10 JMS I XCDOIO /READ FROM THE KEYBOARD ASKBUF, LDBUF+10 /A STRING OF CHARACTERS JMP I RLOOPP /USE DEFAULT VALUE IF EOF ISZ I (RTMP /BUMP REPEAT POINTER TO NEW ENTRY DATFK1, TAD XR DCA GTDTMP DATFAK, AC0002 TAD ASKBUF DCA DES1W /SET UP A FETCH DESCRIPTOR AC7776 DCA DES1B /TO POINT TO THE STRING WE JUST READ TAD I (LDBUF+11 CIA TAD (LDBUF+11 DCA XR1 /MAKE SURE THAT THERE IS A ZERO WORD DCA I XR1 /AFTER THE INPUT CHARACTERS JMP I .+1 DATSM1 ENTERM, -6 4657 /EN 6546 /TE 6301 /R NM1, 0 NM2, 0 NM3, 0 LOADER, RSICDF, CDF 20 /CLEAR OUT FIELD 2 AND UP DCA T TAD R101 DCA I T ISZ T JMP .-3 /CLEAR ALL USER CORE TO BLANKS CDF RSFLD TAD RSICDF TAD P10 DCA RSICDF TAD RSICDF CIA CDF 00 TAD I (TOPFLD CDF RSFLD SMA CLA JMP RSICDF /LOOP FOR AS MANY FIELDS AS NECESSARY JMP I RLOOPP DCLRCH, JMP I .+1 /OR .+2 DATCLD RLOOPP, RLOOP PGET, SYGET DATDAT, TAD ASKBUF /STICK THE DATE IN AND GO TO "DATASK" DCA XR1 AC7775 DCA I XR1 /SET WORD COUNT SINCE DESTINATION MAY BE LARGE CDF 00 TAD I M1 /DATE CDF RSFLD DCA DATDA1 TAD DATDA1 AND P7400 BSWN CLL RTR CALL XOTOPD DCA I XR1 TAD DATDA1 CLL RTR AND P77 CLL RAR CALL XOTOPD DCA I XR1 TAD DATDA1 AND P7 TAD (110 /YEAR ORIGINS AT 1972 CALL XOTOPD OPTDAT, DCA I XR1 TAD (MORDAT&177+5600 /JMP I MORDAT DCA I (RTMP /SET RECYCLE TO DUMMY DATA INIT TAD (3 /BUMP XR PAST IRRELEVANT NAME JMP DATFK1 /NOW PUT IT INTO THE VARIABLE DATDA1, 0 SYMHDR, DCA LENGTH TAD P21 JMS I XRDOIO /READ IN SYMBOLS 7777 /TO BOTTOM OF FIELD 2 JMP I (EOFERR /ERROR READING IN SYMBOLS CDF CIF 00 JMP I (RUNIT /DO IT TO IT TERMNL, 0 TAD TERMNI TAD NLCTR TAD (JOBTBL DCA DATDA1 /TEMP CDF 00 TAD I DATDA1 CDF RSFLD AND P7 JMP I TERMNL COMMAT, TAD NLCTR /TO INSERT LOGICAL TERMINAL #'S CIA /SET COUNTER DCA TERMNI ISZ I (RTMP /SET REPEAT POINTER TO DUMMY ROUTINE TAD (3 /SKIP PAST NAME TAD GTDTMP DCA GTDTMP JMP I (COMMTC /DO THE FIRST ONE DEFAUL, 100 /DEFAULT I/O CHANNEL WORDS R101, 101 /END OF LOADER CODE /EQUIVALENCE CERTAIN ARRAYS WITH THE LOADER CODE ACB= .-DIGITS /ACCUMULATOR "B" ACA= ACB-DIGITS /ACCUMULATOR "A" PDLLIM= ACA-1 BLEN= AS BCNT= BS / PAGE /VT05/TELETYPE DISPLAY ROUTINES DSPLYD, DCA DES2L DBCONV /DISPLAY SPECIAL CHARACTER JMP DDSPLY DSPLYA, TAD ZDES2 POPDES /DISPLAY ALPHA STRING DDSPLY, DCA T /STORE SPECIAL CHARACTER OR ZERO IF STRING DBCONV DCA T1 /SAVE X COORD DBCONV SNA JMP NOPOSN /ROW OF 0 MEANS ONLY PRINT STRING DCA T2 TAD (216 /OUTPUT CONTROL/N CIF 00 CALL ZPUSHJ TTOCHR TAD T2 PUSHJS TTOSPC /OUTPUT Y-COORD AND WAIT TAD T1 TAD P237 CIF 00 CALL ZPUSHJ TTOCHR NOPOSN, TAD DES2L SNA CLA /STRING? JMP OUTSPC /NO - TRY SPECIAL CHAR DSPNXT, GETCH2 TAD P237 CIF 00 CALL ZPUSHJ TTOCHR ISZ DES2L JMP DSPNXT OUTSPC, TAD T CIA CLL CML IAC /SPECIAL CHARS -- 1=CLEAR SCREEN [237) SZL SPA SNA / 2=CLEAR LINE (236) PUSHJS TTOSPC / 0= DO NOTHING CLA JMP I ZILOOP /VT05/TELETYPE STRING ACCEPT ROUTINES ACCEPT, JMS I (STSETP /INITIALIZE OUTPUT DESCRIPTOR TO ALPHA STRING CIF 00 CALL ZPUSHJ TTICHR DCA T TAD T TAD (-336 CLL CML TAD P77 SZL SNA /LEGAL COS CHARACTER? JMP DELIM /NO PUTCHI /YES - STORE IT TAD T CIF 00 CALL ZPUSHJ TTOCHR ISZ PUTDL JMP ACCEPT+1 /AND LOOP JMP .+3 /FIELD OVERFLOW - TREAT AS 0 DELIMITER DELIM, SPA TAD P237 AND P77 /TRUNCATE TO SIXBIT JMS I ZFAKNUM JMP I (STORD /STORE IT INTO THE DELIMITER FIELD TTOSPC, TAD P237 CIF 00 CALL ZPUSHJ NULLS POPJS ERRTRP, TAD T TAD (7000 ONERXX, DCA USRERR /CHANGE FROM A 6000 TO A 5000 TAD PDL DCA OLDPDL JMP I ZILOOP HERET, CLA /TRACE - "CLA IAC" IF /T ON HERENT, DCA TRCFLG /TURN OFF TRACE JMP I ZILOOP /SR CTRLOF, 0 /CALL TO SAVE CTRLO STATE AND TURN OFF JMS JOBIDX TMNLTB DCA CTRLO CDF 00 DCA I USRCF /ZERO TERMINAL TABLE ENTRY CDF RSFLD EXIT CTRLOF CTRLON, 0 /CALL TO RESTORE CTRL/O STATE JMS JOBIDX TMNLTB CDF 00 CLA TAD CTRLO DCA I USRCF CDF RSFLD EXIT CTRLON JOBIDX, 0 /CALL TO GET FIELD ZERO TABLE ENTRY CDF RSFLD TAD I JOBIDX /INDEXED BY JOB # CDF 00 /TABLE POINTER FOLLOWS CALL TAD I (JOB DCA USRCF TAD I USRCF CDF RSFLD ISZ JOBIDX EXIT JOBIDX USRCF, 0 /CALL TO CHANGE DATA FIELD TO USER BASE DCA JOBIDX TAD USRFLD DCA .+1 HLT TAD JOBIDX EXIT USRCF LGETCH, 0 /GET CHARACTER FOR LABEL ROUTINE ISZ DES1L TAD DES1L SMA SZA CLA /RUN OUT OF CHARACTERS? IAC /YES - USE BLANKS SNA GETCH1 /NO - USE CHAR JMP I LGETCH / PAGE PDLTEM, 0 /SIZE,ORG POPDT1, 0 /ORIGIN LITADD, 0 /LITERALS BEGIN AFTER SYMBOLS POPDSX, 0 DCA XR1 POPS DCA POPDT1 /BYTE POINTER POPS AND P7770 /MASK OUT LENGTH IN BYTES CLL RTR RAR SNA TAD K10B /1000 IN DISGUISE CIA DCA I XR1 TAD I PDL AND P7 DCA PDLTEM /SIZE ORIGIN PAIR TAD PDLTEM TAD (-7 SNA CLA JMP PDLVAL TAD PDLTEM /IS IT A LITERAL AND (74 /SAME AS 'AND (4' BUT SHARES A LITERAL SNA CLA JMP NOTLIT /NO TAD LITADD /YES, NEED TO OFFSET TO LITERALS CLL RAL /BYTES TAD POPDT1 DCA POPDT1 SZL ISZ PDLTEM JMP POPC1 NOTLIT, TAD USRBAS /OFFSET TO USER AREA CLL RAL DCA GETC1X RTL /ROTATE CARRY INTO AC8 RAL TAD USRFLD AND (74 /GET RID OF IOT PART CLL RTR TAD PDLTEM DCA PDLTEM TAD GETC1X TAD POPDT1 SZL ISZ PDLTEM DCA POPDT1 POPC1, TAD PDLTEM CLL RAR DCA GETC1X TAD POPDT1 RAR DCA I XR1 CMA RAL DCA I XR1 TAD PDLTEM AND (16 CLL RTL K10B, TAD PCDF DCA I XR1 /STORE CDF ON PAGE ZERO!!! JMP I POPDSX PDLVAL, AC0002 /INDICATE FIELD 2 DCA PDLTEM TAD POPDT1 CLL RAR DCA PDL JMP POPC1 /GET CHARACTER ROUTINES GETC1X, 0 /GET CHARACTER THROUGH DESCRIPTOR 1 CLA /ALL KINDS OF WEIRDIES AROUND THESE DAYS TAD DES1F DCA GETC1F GETC1F, HLT /SET TO CDF TO DATA FIELD ISZ DES1B /TIME(11/23): 16 CYCLES JMP GETC1L /GET LEFT HALF OF WORD AC7776 /RESET BYTE FLAG TO EVEN DCA DES1B TAD I DES1W ISZ DES1W /PROCEED TO NEXT WORD JMP GETC1C CALL (FLDOVR DES1F JMP GETC1C GETC1L, TAD I DES1W BSWN GETC1C, AND P77 CDF RSFLD JMP I GETC1X /RETURN WITH DATA FIELD CORRECT GETC2X, 0 /GET CHARACTER THROUGH DESCRIPTOR 2 CLA TAD DES2F DCA GETC2F GETC2F, HLT /SET TO CDF TO DATA FIELD ISZ DES2B /TIME(11/23): 16 CYCLES JMP GETC2L /GET LEFT HALF OF WORD AC7776 /RESET BYTE FLAG TO EVEN DCA DES2B TAD I DES2W ISZ DES2W /PROCEED TO NEXT WORD JMP GETC2C CALL (FLDOVR DES2F JMP GETC2C /JUST IN CASE GETC2L, TAD I DES2W BSWN GETC2C, AND P77 CDF RSFLD JMP I GETC2X /RETURN WITH DATA FIELD CORRECT POPD1X, 0 /POP DESCRIPTOR 1 (A SPACE-SAVER) TAD (DES1-1 JMS POPDSX JMP I POPD1X FAKNUM, 0 /ROUTINE TO FAKE A 2 DIGIT NUMBER ON THE PUSHDOWN LIST CALL XOTOPD PUSHS /PUT ON PUSHDOWN LIST TAD (27 PUSHS /PUSH A PHONY DESCRIPTOR AC7776 TAD PDL CLL RAL PUSHS /POINTING TO THE 2 DIGIT RESULT JMP I FAKNUM / PAGE /PUT CHARACTER ROUTINE PUTCHX, 0 /PUT CHARACTER THROUGH "PUT" DESCRIPTOR DCA PUTCH1 /STORE CHAR TAD PUTDF DCA PUTCHF PUTCHF, HLT /SET DATA FIELD ISZ PUTDB /TIME(11/23): 23 CYCLES JMP PUTCHL /REPLACE LEFT HALF TAD I PUTDW AND PT7700 /MASK OFF RIGHT HALF TAD PUTCH1 /INSERT AC CHAR DCA I PUTDW /RESTORE AC7776 DCA PUTDB /RESET BYTE FLAG TO EVEN ISZ PUTDW /BUMP POINTER TO NEXT WORD JMP PUTCDF CALL (FLDOVR PUTDF JMP PUTCDF /JUST IN CASE PUTCHL, TAD PUTCH1 BSWN /GET AC CHARACTER INTO LEFT HALF DCA PUTCH1 TAD I PUTDW AND P77 /MASK OFF LEFT HALF OF WORD TAD PUTCH1 /INSERT AC CHAR DCA I PUTDW /RESTORE PUTCDF, CDF RSFLD PUTRET, JMP I PUTCHX /RETURN TAD PUTCHX /SAVE RETURN ADDR PUSHS TAD PUTCH1 /AHA, TRACE IS ON - PRINT OUT THE CHARACTER AND P77 /WATCH OUT THOUGH - IT CAN BE IN EITHER HALF SZA /OF "PUTCH1". JMP FIXASC /RIGHT HALF - GOODIE! TAD PUTCH1 BSWN /MOVE CHAR TO RIGHT HALF FIXASC, TAD P237 CIF 00 CALL ZPUSHJ /BOY IS THIS GOING TO SLOW THINGS DOWN TTOCHR POPJS /RETURN HOPEFULLY TO CALLER PUTJMP= JMP I PUTCHX PUTCH1, 0 ATLINE, DCA HILINE /ROUTINE TO PRINT "AT LINE XXXX" TAD LINENO ISZ HILINE /DIVIDE THE LINE NUMBER BY 100 (DECIMAL) CLL TAD (-144 /AND USE THE MONITOR ROUTINE "OTOPD" SZL /TO CONVERT EACH PAIR OF DIGITS TO JMP .-4 /ASCII -237 CODE TAD K144 CALL XOTOPD /CONVERT LOW ORDER DIGITS DCA LOLINE STA TAD HILINE CALL XOTOPD /HIGH ORDER DIGITS DCA HILINE ATLNDV, TAD (11 /GET DEVICE NUMBER JMS I XCDOIO /PRINT MESSAGE ATMESG-1 K144, 144 DCA TRCJMP POPJS ATMESG, -6 /AT LINE XXXX 4265 0155 5257 4601 HILINE, 0 LOLINE, 0 KILLIT, TAD (LOKARG+TFTSIZ /NOW TO GET RID OF ALL THE LOCKS DCA KILPTR /BELONGING TO THE DYING JOB TAD (-FILMAX DCA KILCTR KILLOO, TAD I KILPTR AND (3700 BSWN CIA CDF 00 TAD I (JOB /FILE LOCKED BY THIS JOB? CDF RSFLD SZA CLA JMP .+4 /NO, LEAVE ALONE TAD I KILPTR AND P77 DCA I KILPTR /STRIP OFF LOCK TAD KILPTR TAD (TFTSIZ /BUMP TO NEXT FILE DCA KILPTR ISZ KILCTR JMP KILLOO CALL ZJOBIX JBRCLK DCA KILPTR TAD (-RCLKMX DCA KILCTR KILNXT, TAD I KILPTR DCA LOLINE /STORE LOCK ARG DCA I KILPTR /REMOVE OLD LOCK BY THIS JOB TAD LOLINE AND P77 SZA CALL (ULKIT /KILL THE LOCK FLAG ON L.U. IF NECESSARY ISZ KILPTR ISZ KILPTR ISZ KILCTR JMP KILNXT CDF CIF 00 /RUNNING OUT OF ROOM JMP I (PTUNLK /IN CASE JOB HAS PTR OR PTP DKDOIT, CIF 0 JMS I (DSKQ CALL ZJOBIX QUETBL PT7700, SMA CLA POPJS DKERTN, FATAL / PAGE /MAIN INTERPRETER LOOP ILOOP, CDF RSFLD CLA ISZ INSTCT JMP ILOOPC RELEAS, CIF 00 CALL ZPUSHJ SLEEP ILOOPS, TAD (-EXECNT DCA INSTCT ILOOPC, JMS I ZFETPC DCA T ILOOPE, TAD T CLL RTL RTL AND P7 /GET OP CODE SNA JMP NOSTR /OPERATE CLASS INSTRUCTION TAD IJUMP DCA IJMP TAD T AND (777 SNA BR0ERR, ERROR /BRANCH 0 OCCURS JUST AFTER XMIT'S CLL RAL TAD (-2 DCA XR SYMCDF, CDF 20 /SET TO FIELD OF SYMBOL TABLE TAD I XR DCA IST1 TAD I XR DCA IST2 /MOVE THE SYMBOL TABLE ENTRY INTO LOWER CORE CDF RSFLD IJMP, HLT /GO TO THE APPROPRIATE ROUTINE NOSTR, TAD T TAD (-100 SMA /IS IT A CONDITIONAL SKIP? JMP I (BRACND /YES TAD IJMP2 DCA .+1 /FOR OPERATE CLASS INSTRUCTIONS, THE OPCODE HLT /IS THE LOW-ORDER BITS INSTCT, 0 /INTERPRETIVE OP-CODE TABLES IJUMP, JMP I . /TABLE OF "MEMORY REFERENCE" OPERATORS PPUSHS, PUSHRS PUSH1S PUSH2S BRASUB BRANCH ERRTRP LININC IJMP2, JMP I .+101 /TABLE OF "OPERATE CLASS" OPERATORS ILOOP /0 ; WAS SETTRP MULTPY ADD IMAGE SUB UMINUS DIVIDE NUMSGN ROUND /10 CLRA CLRD BCMPTD RETURN STOP INIT XMIT READ /20 WRITE FINI FORMS STORA D2A A2D STORD HEREDC /30 ADDST SUBST HERET ASUNIT DSPLYA DSPLYD ACCEPT INCRMT /40 RELEAS /REPLACES CHAIN ONERXX HERENT LOKREC LOCK ULOKRC UNLOCK CDINIT, TAD I T /GET DEVICE NUMBER AND P7 CDF RSFLD TAD (JMP I CDDEVI DCA CDIJ /STORE DISPATCH TO INIT FOR DEV CDIJ, HLT CDDEVI, ILOOP /KBD - ALWAYS READY ILOOP /TTY - ALWAYS READY CDRINI /CDR - NEVER READY (TEMP?) PTPINI /PTP - MAY BE READY PTRINI /PTR - MAY BE READY LPTINI /LPT - IT'LL NEVER WORK CDFINI, TAD I T /OPPOSITE OF INIT ABOVE AND P7 /GET DEVICE # TAD (JMP I CDDEVF DCA CDFJ TAD I T /PRESERVE THIS FOR LPT USE DCA CDIJ DCA I T /CLEAR FARRAY ENTRY TO FREE CHANNEL CDF RSFLD TAD CDIJ DCA I (IOCOMN /NOW THAT DF IS RIGHT... CDFJ, HLT CDDEVF, ILOOP /KBD - NOP ILOOP /TTY - NOP ILOOP /CDR - CANNOT BE INITED? PTPFIN /PTP - CLEAR JOB # PTRFIN /PTR - CLEAR JOB # LPTJMP /LPT - WRITE EOF, WRITE PARTIAL BLOCK / PAGE /PUSH A SUBSCRIPTED DESCRIPTOR ONTO THE STACK PUSH1S, DBCONV /GET THE SUBSCRIPT SZA TAD M1 /TREAT ZERO LIKE 1 SNA JMP I (PUSHRS /SUBSCRIPT OF 1 IS A NO-OP DCA T TAD IST1 AND P7770 CLL CML CMA RTR RTR /LENGTH/2 IN AC, LOW-ORDER BIT IN LINK DCA T1 STA RAL DCA T2 /T2=-1 IF LENGTH WAS EVEN SKP TAD T ISZ T1 /MULTIPLY (SUBSCRIPT-1)*(LENGTH/2) JMP .-2 CLL RAL /DOUBLE RESULT ISZ T2 BUMPID, TAD T /ADD IN (SUBSCRIPT-1) IF LENGTH ODD TAD IST2 DCA IST2 SZL ISZ IST1 TAD IST1 AND P7 DCA T /SET UP TO CHECK THAT WE ARE STILL TAD IST1 /IN THE DATA SPACE CLL RAR AND M4 CLL RTR TAD IST2 /COMPUTE THE ADDRESS OF THE LAST CHARACTER IN SZL /THIS FIELD ISZ T CLL TAD SSLIM2 /COMPARE AGAINST DATA SECTION LIMITS CLA RAL TAD T TAD SSLIM1 SZL CLA SSERR, FATAL /WATCH OUT! TRYING TO DESTROY PROCEDURE CODE JMP I (PUSHRS /PUSH THE SUBSCRIPTED DESCRIPTOR SSLIM1, 0 SSLIM2, 0 /DATA SECTION UPPER LIMIT /DECIMAL-TO-ALPHA CONVERSION OPERATOR D2A, POPNUM /GET THE NUMBER JMS I (SETXRT TAD XR DCA XR1 /SET UP AUTO-XRS FOR KLUDGE SCAN D2ASLP, TAD I XR /TURN ALL NON-SIGNIFICANT DIGITS SZA CLA JMP D2ASIG /TO PSEUDO-BLANKS (-20'S) TAD DA7760 DCA I XR1 ISZ T JMP D2ASLP DCA I ALAST /PUT THE LAST DIGIT BACK D2ASIG, TAD AS /WHEN WE FIND A SIGNIFICANT DIGIT, WE CHANGE BS7700, SMA CLA JMP I (SHTCUT /THE LAST BLANK TO A PSEUDO-MINUS SIGN (-3) TAD XR1 /IF THE SIGN OF THE NUMBER IS NEGATIVE DCA T DCA AS /THEN WE ZERO OUT THE SIGN AC7775 DCA I T JMP I (SHTCUT /THEN GO STORE THE RESULTING ABORTION PTRINI, IAC PTPINI, TAD (PTPJOB DCA T2 CDF 00 TAD I T2 SPA CLA /ALREADY IN USE? JMP CDEXT-1 /NO, GO AHEAD TAD I T2 /IN USE BY WHO? CIA TAD I (JOB SZA CLA /MEMEME? JMP CDPIGY /SOMEBODY ELSE DONE GOT IT FUST TAD I (JOB /FILL WITH JOB # TO ASSIGN CDEXT, DCA I T2 JMP I ZILOOP CDPIGY, CALL ZUSRCF /HAVE TO CLEAR FARRAY ENTRY JUST SET UP DCA I T CDINER, ERROR /THEN LET HIM HAVE IT PTRFIN, IAC PTPFIN, TAD (PTPJOB DCA T2 CDF 00 /JOB MUST HAVE IT OR WE WOULDN'T BE HERE AC4000 /RIGHT? JMP CDEXT DA7760, BADUNT, SMA SZA SNL CLA /ALL WE REALLY WANT IS "CLA" INU11, 11 /BE ASSURED THE ABOVE JUST DOES CLA TAD (ILUNT-1-INU+1 INUSE, TAD (INU-1 DCA ERP TAD INU11 JMS I XCDOIO ERP, ILUNT-1 /"?ILLEGAL UNIT BSWT, DKEPTR, 0 JMP I (ASKHIM /BYTE SWAP SIMULATION ROUTINE. / /IT ONLY WORKS FOR FIELD 1, YOU WILL NOTICE / BSWX, 0 DCA BSWT RTR RTR RTR TAD BSWT AND BS7700 TAD BSWT RTL RTL /ROTATE CORRECT DIRECTION OR SUFFER RTL /EGREGIOUS EFFECTS JMP I BSWX RDPAT, AC7776 /GOT A + WC FROM RDOIO, WHY? TAD COUNT /EOU = 2 SZA CLA JMP I (RTNM1 /ANYTHING ELSE = BAD, OUT, NO GOOD JMP I (NOROM1 /PLAY IT AGAIN, SAM / PAGE /TRANSFER OF CONTROL INSTRUCTIONS BRASUB, TAD PC /SUBROUTINE CALL PUSHS /PUSH THE CURRENT STATE OF THE PC TAD PCFLD PUSHS /(FIELD AND ADDRESS) TAD LINENO PUSHS /UNCONITIONAL GOTO ROUTINE BRANCH, TAD IST2 /TIME(9/14): 33 CYCLES DCA PC /SET PC TO LOC-1 AS WE BUMP FIRST TAD IST1 /WATCH FOR DUMB FIELD CARRIES AND P7 CLL RTL RAL TAD PCDF JMP BUMPX RETURN, POPS DCA LINENO POPS SMA RETERR, FATAL DCA PCFLD /RESET PAGE ZERO PC FIELD POPS DCA PC JMP I ZILOOP /AND CONTINUE BRACND, CLL RAR /CONDITIONAL SKIP - CONDITIONS ARE SPECIFIED TAD P7400 /OPCODES ARE ORGANIZED CLEVERLY DCA COND /TRANSLATE THEM INTO A SKIP INSTRUCTION SNL /BIT 11 TELLS WHETHER IT IS A DECIMAL JMP ALPHCP /OR ALPHA COMPARE - 0 IS ALPHA, 1 DECIMAL AC4000 JMS I (DOADD /DECIMAL - DO A SUBTRACTION JMS I (SETXRT TAD I XR ISZ T JMP .-2 /ADD UP ALL OF THE DIGITS SZA /DON'T USE SIGN IF MAGNITUDE IS ZERO TAD AS CONDM1, CLL RAL /SIGN IN LINK, 2*(SUM OF DIGITS) IN AC COND, HLT /TEST VARIOUS AC-LINK COMBINATIONS JMS FETPC /SKIP THE NEXT INSTRUCTION IF NECESSARY CLA JMP I ZILOOP ALPHCP, POPDS1 /ALPHA COMPARE - POP OFF THE DESCRIPTORS TAD ZDES2 POPDES TAD DES1L /IF ONE IS LONGER THAN THE OTHER CIA CLL TAD DES2L SNL CLA /USE THE SHORTER LENGTH AS THE TAD DES1L /COMPARISON COUNT DCA DES1L ALCPLP, GETCH1 /GET A CHAR FROM DES1 DCA T1 GETCH2 /GET A CHAR FROM DES2 CIA CLL TAD T1 SZA JMP COND /AGAIN, THE LINK TELLS WHICH IS LARGER ISZ DES1L JMP ALCPLP /LOOP FOR ALL CHARACTERS JMP CONDM1 /ZERO LINK & REPORT EQUALITY FETPC, 0 /SUBROUTINE TO FETCH NEXT INSTRUCTION ISZ PC /TIME(10/24): 10 CYCLES JMP PCCDF-2 /NO FIELD CHANGE TAD PCFLD TAD P10 DCA PCFLD /BUMP FIELD TAD PCFLD DCA .+1 PCCDF, 0 TAD I PC CDF RSFLD JMP I FETPC BCMPTD, JMS FETPC /COMPUTED GOTO DCA FETPC /GET LIMIT DBCONV /GET INDEX AND CONVERT TO BINARY DCA T TAD BS /CHECK IF SIGN WAS NEGATIVE AND (40 SNA CLA /IF IT WAS, INDEX IS OUT OF RANGE TAD T CIA CLL TAD FETPC SNL /TEST FOR 0 OR OUT OF RANGE STA CMA TAD FETPC BUMPPC, TAD PC DCA PC /BUMP THE PC BY THE PROPER INCREMENT RTL /SO THAT THE NEXT INSTRUCTION WE WILL EXECUTE RTL /WILL EITHER BE THE DESIRED BRANCH INSTRUCTION TAD PCFLD /OR (IF THE INDEX WAS ILLEGAL) THE INSTRUCTION BUMPX, DCA PCFLD /AFTER THE ENTIRE BRANCH LIST JMP I (ONERXX LPATCH, ISZ PDL ISZ PDL TAD PCFLD PCSUB1, TAD P7770 DCA PCFLD /BUMP DOWN DATA FIELD STA CLL JMP BUMPPC /NOW INCREMENT PC BY 4095 CDOIO, 0 CDF RSFLD /SELF-PRESERVATION DCA DEVNUM AC0002 TAD CDOIO PUSHS TAD I CDOIO CIF 00 CALL ZPUSHJ CDQ CALL ZJOBIX QUETBL SMA CLA POPJS RTNM1, POPS /JMP HERE FROM ANYWHERE TO TAKE ERROR TAD M1 /RETURN FROM PUSHJ'D ROUTINE DCA DEVNUM JMP I DEVNUM DEVNUM, 0 / PAGE /ARITHMETIC ROUTINES SUB, AC4000 ADD, JMS I (DOADD /ADD AND SUBTRACT USE SAME SUBROUTINE PUSHA, TAD PDL DCA PUTDW AC7776 DCA PUTDB /SET UP THE "PUT" DESCRIPTOR TO STORE TAD RSCDF /CHARACTERS ONTO THE PUSHDOWN LIST DCA PUTDF TAD PDL CLL RAL /SET UP A FAKE DESCRIPTOR TO POINT TO THE DCA IST2 /CURRENT POSITION OF THE PUSHDOWN LIST RAL TAD P17 DCA IST1 JMS I (SETXRT TAD I XR /ELIMINATE LEADING ZEROS FROM THE NUMBER THAT WE SZA /ARE PUSHING JMP STORIT /FOUND A SIGNIFICANT DIGIT - START STORING ISZ T JMP .-4 JMP STLSDG /NUMBER WAS ZERO - STORE A SINGLE 0 AS RESULT STORLP, TAD P21 PUTCHI /STORE CHARACTER IN -237 ASCII TAD IST1 TAD P10 DCA IST1 /BUMP LENGTH IN DESCRIPTOR TAD I XR STORIT, ISZ T /IS THIS THE LAST DIGIT? JMP STORLP /NO - KEEP GOING TAD AS /THE LAST DIGIT IS SPECIAL AS WE MUST SPA /FLAG IT IF THE NUMBER IS NEGATIVE TAD (4040 /THE FLAG CONSISTS OF A 40 BIT STLSDG, TAD P21 PUTCHI /STORE THE FINAL DIGIT AC0002 TAD PUTDB /USE THE LEFT-RIGHT INDICATOR TAD PUTDW /TO BUMP THE WORD POINTER UP, IF NECESSARY DCA PDL /SAVE NEW PUSHDOWN POINTER PUSHRS, TAD IST1 /PUSH A DESCRIPTOR ONTO THE STACK PUSHS TAD IST2 PUSHS JMP I ZILOOP ADDAB, 0 /ADD A-REGISTER TO B-REGISTER TAD NUMLEN /AC ON ENTRY HAS NUMBER OF DIGITS TO IGNORE DCA T TAD ALAST /TIME(11/4): 28N+9 IF SIGNS ARE EQUAL DCA T1 / 27N+14 IF SIGNS ARE UNEQUAL TAD (ACB+DIGITS-1 / 45N+27 IF SIGN CHANGES DCA T2 /WHERE N=NUMBER OF SIGNIFICANT(NON-IGNORED) DIGITS TAD AS TAD BS SMA CLA /IF SIGNS ARE EQUAL DO AN ADD, JMP ADDPOS /OTHERWISE DO A SUBTRACT TAD T DCA CMPCNT /SUBTRACT - SAVE DIGIT COUNT, WE MIGHT NEED IT JMP ADDNEG /FOR THE RE-COMPLEMENT. JUMP INTO THE LOOP. ANEGLP, STA TAD T1 DCA T1 STA TAD T2 /THIS CODE IS DUPLICATED IN THE ADD LOOP FOR SPEED DCA T2 RAL /TWO AC OVERFLOWS LEAVE THE LINK THE SAME ADDNEG, TAD I T2 CIA TAD I T1 /DO A DIGIT SUBTRACT CLL SPA /IF THE RESULT IS NEGATIVE TAD (12 /WE HAVE TO BORROW FROM THE NEXT PLACE DCA I T1 ISZ T /THE CARRY IS NOW IN THE LINK JMP ANEGLP SNL CLA /CARRY AT THE END MEANS THE SIGN CHANGED JMP I ADDAB /IT DIDN'T - GO AWAY HAPPY TAD ALAST DCA T1 TAD CMPCNT DCA T /SET UP FOR RECOMPLEMENT CLL NEGLP, CLA RAL /GET THE PREVIOUS CARRY TAD I T1 /THIS IS ACTUALLY A TEN'S COMPLEMENT OPERATION SNA JMP .+4 /WATCH OUT FOR ZEROS SO THEY DON'T BECOME 10'S CIA TAD (12 DCA I T1 STA CML /THIS COMPLEMENTS THE LINK TAD T1 /THIS COMPLEMENTS IT AGAIN DCA T1 ISZ T JMP NEGLP TAD BS /RECOMPLEMENT MEANS CHANGE SIGNS - HOWEVER THIS DCA AS /IS FASTER SINCE WE KNOW THE SIGNS WERE DIFFERENT JMP I ADDAB APOSLP, STA TAD T1 /THIS IS THE DUPLICATED CODE DCA T1 STA TAD T2 DCA T2 RAL /GET THE CARRY INTO THE AC ADDPOS, TAD I T1 TAD I T2 TAD (-12 /CHECK THAT THE SUM OF THESE DIGITS IS NOT > 10 CLL CML SPA TAD (12 /NO - CLEAR THE LINK AND RESTORE THE RESULT DCA I T1 ISZ T JMP APOSLP JMP I ADDAB RNDADD, TAD M4 SMA SZA CLA /DIGIT GREATER THAN 4 MEANS WE SHOULD BUMP IAC JMS I ZFAKNUM /PUT A 0 OR A 1 ON THE STACK AC0002 POPNUM /AND FROM THERE INTO ACCUMULATOR B TAD AS DCA BS /SET SIGNS EQUAL FOR MAGNITUDE ADD JMS ADDAB JMP PUSHA /STORE RESULT ON STACK / PAGE /MULTIPLY AND UNARY MINUS ROUTINES MULTPY, AC0002 POPNUM /GET THE ARGUMENTS TAD T /GET THE NUMBER OF DIGITS STORED TAD NUMLEN CMA /FORM AN INITIAL COUNT OF THE NUMBER OF DIGITS TO DCA DVTEMP /IGNORE ON ADDS (LESS ONE FOR CARRIES) POPLFT /(GET THE MULTIPLIER LEFT ADJUSTED) JMP MULZRO /MULTIPLICAND IS ZERO MEANS RESULT IS ZERO TAD AS TAD BS DCA AS /COMBINE SIGNS TO GET RESULT SIGN TAD AS DCA BS /SET SIGNS THE SAME SO ADDITION WILL WORK CLA IAC TAD QDIGIT /GET NUMBER OF LEADING ZEROS IN MULTIPLIER TAD NUMLEN /CALCULATE THE NUMBER OF SIGNIFICANT DIGITS DCA QDIGIT /STORE THAT COUNT MULTLP, TAD I AP1 /GET THE LEADING DIGIT OF THE MULTIPLIER CMA DCA ALEFT JMP .+3 /USE IT AS AN ADD COUNTER TAD DVTEMP JMS I (ADDAB /DO AN ADD OF SUITABLE LENGTH ISZ ALEFT JMP .-3 DCA I AP1 /KILL THE DIGIT WE JUST USED ISZ QDIGIT /IS THIS THE LAST DIGIT? SKP /NO JMP I (PUSHA /YES - DON'T SHIFT, WE'RE THROUGH JMS ALEFT /SHIFT MULTIPLIER AND PRODUCT LEFT 1 STA TAD DVTEMP /BUMP DOWN THE NUMBER OF DIGITS TO IGNORE DCA DVTEMP /ON ADDS JMP MULTLP /START ON NEXT MULTIPLIER DIGIT UMINUS, POPNUM AC4000 TAD AS DCA AS JMP I (PUSHA AP1, ACA+1 /DIVIDE ROUTINE DIVIDE, AC0002 POPLFT /GET DIVISOR LEFT ADJUSTED D0ERR, ERROR /DIVISION BY ZERO IS AN ERROR TAD QDIGIT DCA DBCNVX /STORE NUMBER OF TRAILING BLANKS IN THE DIVISOR POPLFT /GET DIVIDEND LEFT ADJUSTED JMP MULZRO /DIVISION INTO ZERO GIVES ZERO TAD AS TAD BS DCA DVTEMP /SAVE THE SIGN OF THE RESULT TAD DBCNVX CMA CLL /FORM THE DIFFERENCE BETWEEN THE NUMBER OF TAD QDIGIT /TRAILING ZEROS IN THE TWO NUMBERS DCA BS /SNEAKY - THIS SETS THE DIVIDEND NEGATIVE SZL /OR DID IT? - IF THE DIVIDEND HAS LESS TRAILING JMP MULZRO /ZEROS THAN THE DIVISOR, THE QUOTIENT IS ZERO! SKP /JUMP INTO THE DIVISION LOOP DIVLP1, JMS ALEFT /SHIFT DIVIDEND LEFT 1 AND EXPOSE NEW QUOTIENT DIGIT DCA AS /SET AS DIFFERENT THAN BS (WHICH IS NEGATIVE) DIVLP2, TAD I A SZA CLA /IF A HAS MORE PRECISION THAN B, JMP TRYSUB /THEN SUBTRACTION WILL SUCCEED TAD I AP1 CMA CLL /SINCE SUBTRACTION IS SO TIME-CONSUMING, TAD I BP1 /DO A QUICK TEST TO SEE IF B>A. SZL CLA JMP DONTRY /IT IS - DON'T EVEN TRY TO SUBTRACT TRYSUB, JMS I (ADDAB TAD AS SPA CLA /DID THE SUBTRACTION FORCE A NEGATIVE? JMP DVOOPS /YES - ADD B BACK IN ISZ I ALAST /BUMP QUOTIENT DIGIT JMP DIVLP2 DVOOPS, DCA AS /MAKE A AND B SIGNS DIFFERENT AGAIN JMS I (ADDAB /THIS MAKES A NEGATIVE AGAIN BUT WE DON'T CARE DONTRY, ISZ BS /BUMP DIGIT COUNT JMP DIVLP1 /KEEP GOING TAD DBCNVX /DONE - ZERO OUT THE REMAINDER BY FAKING "MULZRO" MULZRO, JMS SETXRT /ZERO ALL OF A OR ONLY THE HIGH ORDER DIGITS DCA I XR /DEPENDING ON THE AC ON ENTRY TO MULZRO ISZ T JMP .-2 TAD DVTEMP DCA AS /THIS IS IGNORED ON MULTIPLY AS RESULT IS 0 JMP I (PUSHA /PUSH THE RESULT DVTEMP, 0 BP1, ACB+1 ALEFT, 0 /SUBROUTINE TO SHIFT A LEFT ONE PLACE TAD A /TIME(10/24): 172 CYCLES DCA XR2 CLA IAC JMS SETXRT /SET UP FOR SHIFT LOOP TAD I XR2 /MOVE EACH DIGIT DCA I XR /TO THE DIGIT SLOT BEFORE IT ISZ T /LOOP N-1 TIMES WHERE N IS THE NUMBER OF DIGITS JMP .-3 DCA I XR /ZERO THE LAST DIGITS PLACE JMP I ALEFT DBCNVX, 0 /DECIMAL TO BINARY CONVERSION ROUTINE POPDS1 /TIME(11/23): 36L+60 CYCLES DBCVLP, DCA QDIGIT TAD QDIGIT CLL RTL TAD QDIGIT /MULTIPLY PREVIOUS RESULT BY 10 RAL DCA QDIGIT GETCH1 /GET A CHARACTER FROM THE NUMBER DCA BS STA TAD BS AND P17 TAD QDIGIT /ADD IT TO THE RESULT ISZ DES1L /MORE? JMP DBCVLP /YES - STORE NEW RESULT AND LOOP JMP I DBCNVX /RETURN WITH RESULT IN AC SETXRT, 0 TAD NUMLEN /** AC MAY NOT BE ZERO ON ENTRY! ** DCA T TAD (ACA-1 DCA XR /INITIALIZE COUNT AND INDEX PTR JMP I SETXRT ASUNIT, DBCONV /GET THE NUMBER ON THE STACK AND P17 /MAKE SURE ITS LEGAL DCA TIFN JMP I ZILOOP /STORE IT IN THE MONITOR "INIT" ROUTINE / PAGE /DECIMAL TO ALPHA CONVERSION (EDITED) IMAGE, TAD ZDES2 POPDES /GET DESCRIPTOR OF EDIT FIELD DCA AS /FIXES EDIT-ZERO KLUDGE POPLFT /GET NUMBER TO BE EDITED JMP ZEROT /THE NUMBER 0 HAS 0 SIGNIFICANT DIGITS TAD QDIGIT /COMPUTE THE NUMBER OF TAD NUMLEN /SIGNIFICANT DIGITS CMA ZEROT, DCA T /AND STORE IT TAD DES2L DCA DES1L TAD DES2W /COPY THE EDIT DESCRIPTOR, DCA DES1W /AS WE MUST MAKE 2 PASSES OVER THE FIELD TAD DES2B DCA DES1B TAD DES2F DCA DES1F TAD DES2L DCA IMIGNR /SET COUNTER TO LENGTH OF EDIT FIELD CLA IAC DCA IBLCHR /BLANK FILL SCANLP, GETCH2 /GET A CHAR FROM THE EDIT FIELD TAD (-13 SZA JMP .+3 TAD (13 DCA IBLCHR TAD (-56 CLL RTR SZA CLA /IS IT AN X OR A Z? JMP SCANSZ /NO SZL /YES - IS IT A Z? ISZ IMIGNR /YES - BUMP COUNTER DOWN BY 1 STA /BUMP DOWN THE SIG DIG COUNT TAD T DCA T SCANSZ, ISZ DES2L JMP SCANLP JMS I (STSETP /SET UP RESULT DESCRIPTOR AND TRACE HOOK LBLOOP, TAD IMIGNR /GET THE COUNTER (WHICH IS, AS YOU MAY HAVE CIA /GUESSED, THE LENGTH OF THE EDITED FIELD) TAD PUTDL /AND COMPARE IT TO THE RESULT FIELD LENGTH. SMA JMP SETIGN /IT'S LARGER - WE'LL HAVE TO IGNORE SOME CHARACTERS CLA IAC /ITS SMALLER - PUT OUT A BLANK PUTCHI ISZ PUTDL /REDUCE THE RESULT LENGTH JMP LBLOOP /AND CONTINUE JMP I ZILOOP /THE EDITED FIELD IS NULL - THE RESULT IS BLANKS SETIGN, CMA DCA IMIGNR /SET IGNORE COUNT (-1 MEANS NONE, -2 ONE, ETC.) TAD A DCA XR /INITIALIZE DIGIT XR TAD IMJBLN DCA IPERSW /INITIALIZE THE PERIOD SWITCH IMGLP, GETCH1 /GET A CHARACTER FROM THE EDIT FIELD TAD (-17 SZA /IS IT A PERIOD? JMP .+3 /NO TAD IMGSZA DCA IPERSW /SET PERIOD SWITCH ON IAC IMGSZA, SZA /IS IT A MINUS SIGN? JMP NOTMNS /NO TAD DES1L /DISTINGUISH BETWEEN IMBEDDED MINUS CMA /SIGNS AND LEADING OR TRAILING ONES - SZA CLA /WE ALWAYS WANT TO PRINT IMBEDDED TAD T /MINUS SIGNS BECAUSE THEY MIGHT BE PART OF SMA SZA CLA /A PART NUMBER OR SOMETHING JMP NOTMNS /BIG DEAL. TAD AS SMA CLA /IS THE NUMBER NEGATIVE? TAD (40-55 /NO - PRINT BLANK INSTEAD OF MINUS SIGN NOTMNS, IAC SZA /IS IT A COMMA? JMP .+4 /NO TAD T SPA SNA CLA /HAVE WE PRINTED A SIGNIFICANT DIGIT YET? IMJBLN, JMP IMBLNK /NO - DON'T PRINT COMMA TAD (54-130 CLL RTR SNA /IS IT AN X OR A Z? JMP XORZ /YES RTL TAD (71 IMOPUT, ISZ IMIGNR /ARE WE STILL IGNORING CHARACTERS JMP IMNXTC /YES PUTCHI /OUTPUT THIS CHAR STA DCA IMIGNR /RESET IGNORE COUNT IMNXTC, CLA ISZ DES1L /ARE WE DONE? JMP IMGLP /NO JMP I (STEXIT /GO TO COMMON CODE WITH "STORA" XORZ, ISZ T /BUMP SIGNIFICANT DIGIT COUNTER TAD T /NEGAIVE OR ZERO MEANS NO SIGNIFICANCE YET SPA SNA CLA /SHOULD WE PRINT THIS DIGIT? IPERSW, HLT /EITHER "JMP IMBLNK"(PRINT BLANK) OR "SKP"(PRINT 0) TAD I XR /GET A DIGIT FROM THE NUMBER TAD P21 /CONVERT TO ALPHA SNL /LINK IS ON IF EDIT CHAR WAS "Z" JMP IMOPUT /IT WAS "X" - GO PRINT JMP IMNXTC /"Z" - IGNORE THIS DIGIT IMBLNK, TAD IBLCHR JMP IMOPUT IBLCHR, 0 CLRD, TAD (20 /DECIMAL CLEAR - FILL WITH ZEROS CLRA, IAC /ALPHA CLEAR - FILL WITH BLANKS DCA T1 /TIME(11/23): 31L+85 JMS I (STSETP /SET UP DESCRIPTOR OF CLEAR-EE CLRLP, TAD T1 PUTCHI /FILL THE FIELD WITH WHATEVER ISZ PUTDL JMP CLRLP JMP I (STEXIT IMIGNR, 0 / PAGE /PACKED DECIMAL TO UNPACKED DECIMAL ROUTINES POPNMX, 0 /PACKED TO UNPACKED RIGHT JUSTIFIED JMS POPGTA /SET UP COMMON POINTERS TAD DES1L /TIME(11/23): 26L+145 CYCLES IFZERO DIGITS-23&4000 < CIA TAD NUMLEN DCA POPGTA DCA I XR2 /ZERO OUT HIGH-ORDER DIGITS ISZ POPGTA /WITH AN ISZ LOOP JMP .-2> IFNZRO DIGITS-23&4000 < CMA TAD (JMP DCAXR2 /COMPUTE JUMP INTO ZEROING TABLE DCA .+1 HLT /JUMP! DCAXR2, IFZERO DIGITS-2&4000 IFZERO DIGITS-3&4000 IFZERO DIGITS-4&4000 IFZERO DIGITS-5&4000 IFZERO DIGITS-6&4000 IFZERO DIGITS-7&4000 IFZERO DIGITS-10&4000 IFZERO DIGITS-11&4000 IFZERO DIGITS-12&4000 IFZERO DIGITS-13&4000 IFZERO DIGITS-14&4000 IFZERO DIGITS-15&4000 IFZERO DIGITS-16&4000 IFZERO DIGITS-17&4000 IFZERO DIGITS-20&4000 IFZERO DIGITS-21&4000 IFZERO DIGITS-22&4000 > DCA T /ZERO DIGIT COUNTER JMS GETDIG /GET FIRST DIGIT OF NUMBER - BLANK IS ZERO JMS POPCMN /CALL SUBROUTINE TO UNPACK DIGITS JMP I POPNMX POPLFX, 0 /PACKED TO UNPACKED LEFT JUSTIFIED JMS POPGTA /TIME(11/23): 21L+217 CYCLES DCA I XR2 /SET LEFTMOST DIGIT TO ZERO TAD NUMLEN /INITIALIZE COUNTER USED LATER TO INSERT IAC DCA T /TRAILING ZEROS DCA QDIGIT /INITIALIZE COUNT OF TRAILING ZEROS LZLOOP, JMS GETDIG SZA /DON'T INSERT LEADING ZEROS JMP SIGDIG ISZ DES1L JMP LZLOOP JMP I POPLFX /HMN - ALL WE GOT IS LEADING ZEROS - RETURN SIGDIG, JMS POPCMN /UNPACK DIGITS AND SIGN DCA I XR2 ISZ QDIGIT ISZ T /ZERO OUT LOW ORDER DIGITS OF ACCUMULATOR JMP .-3 ISZ POPLFX JMP I POPLFX /SKIP RETURN TO SHOW SOMETHING IS THERE POPGTA, 0 /SETUP ROUTINE FOR POPNUM AND POPLFT TAD (A DCA T1 /POINTER TO AC CONTROL BLOCK STA /TIME(10/24): 100 CYCLES TAD I T1 DCA XR2 /XR2 POINTS TO ACCUMULATOR -1 POPDS1 /GET A DESCRIPTOR OFF OF THE STACK TAD NUMLEN CMA CLL TAD DES1L /MAKE SURE THAT THE NUMBER WILL FIT SNL CLA /IN THE ACCUMULATORS NUMERR, ERROR /IT WON'T JMP I POPGTA /RETURN POPCMN, 0 /TIME(10/24): 32L-10 CYCLES JMP POPCTS /START IN MIDDLE OF LOOP POPCLP, DCA I XR2 /STORE DIGIT JMS GETDIG /GET DIGIT, TREATING BLANK AS 0 POPCTS, ISZ T /BUMP DIGIT COUNTER SKP JMP NUMERR /OOPS - TOO MANY DIGITS IN POPLFT ISZ DES1L /IS THIS THE LAST DIGIT? JMP POPCLP /NO - STORE IT AND GET ANOTHER CLL SPA /FUDGE FOR A2D CONVERSION JMP .+3 TAD PP7740 /LAST DIGIT MAY HAVE SIGN FLAG IN 40 BIT AND (37 /PUSH FLAG INTO LINK AND ISOLATE DIGIT IN AC DCA I XR2 /SAVE LAST DIGIT RAR /GET LINK ISZ T1 /SECOND WORD OF CONTROL BLOCK IS SIGN WORD DCA I T1 JMP I POPCMN /RETURN NUMSGN, POPDS1 /GET DESCRIPTOR GETCH1 /GET FIRST CHARACTER JMS I ZFAKNUM /PUT IT ON THE STACK JMP I ZILOOP /RETURN /"INCREMENT" OPERATOR INCRMT, POPDS1 TAD DES1L DCA PUTDL /SAVE LENGTH SKP GETCH1 ISZ DES1L /SKIP TO LAST DIGIT JMP .-2 PP7740, SMA SZA CLA /ALL WE REALLY WANT IS CLA INC33, 33 /MAKE SKIPS HARMLESS INCRLP, TAD DES1F DCA PUTDF TAD DES1B DCA PUTDB TAD DES1W DCA PUTDW /SET PUT DESCR TO GET DESCR JMS GETDIG TAD (-11 /IS THE DIGIT A 9? SNA JMP INCARY /YES - PERFORM A CARRY TAD INC33 /INCREMENT IT PUTCHI JMP I ZILOOP INCARY, TAD P21 PUTCHI /9 GOES TO ZERO STA TAD DES1W DCA DES1W /BUMP CHAR PTR BACK 2 (GETCH1 BUMPED IT +1) CALL (GTUNDF /CHECK FOR CDF CHANGE ON DECREMENT ISZ PUTDL /CHECK FOR OVERFLOW JMP INCRLP JMP NUMERR /NUMBER OVERFLOWED 99999.... GETDIG, 0 GETCH1 TAD M1 A2DKLG, SZA /NOP'D BY A2D ROUTINE TAD (-20 /TREAT BLANK AS 0 JMP I GETDIG / PAGE /STORE OPERATORS STSETP, 0 /STORE SETUP SUBROUTINE TAD (PUTDES-1 POPDES /GET DESTINATION TAD TRCJMP DCA I (PUTRET /ENABLE TRACE OUTPUT JMP I STSETP /RETURN STORA, POPDS1 /GET SOURCE JMS STSETP /STORA ALPHANUMERIC OPERATOR STALP, GETCH1 PUTCHI /MOVE A CHARACTER ISZ DES1L /INPUT EXHAUSTED? SKP /EVIDENTLY NOT JMP STEXIT /YES - DON'T ALTER THE REST OF THE DESTINATION ISZ PUTDL JMP STALP /GO TILL DESTINATION FULL STEXIT, TAD (PUTJMP /STORE CLEANUP ROUTINE DCA I (PUTRET /DISABLE TRACE OUTPUT TAD TRCJMP SZA CLA /WAS THERE ANY? JMP I ZILOOP /NO TAD S11 JMS I XCDOIO .-1 /SUAVE WAY OF OUTPUTTING CRLF S11, 11 JMP I ZILOOP STORD, POPDS1 /GET SOURCE JMS STSETP /STORE DECIMAL OPERATOR TSD2SM, TAD DES1L CMA CLL TAD PUTDL /COMPUT NUMBER OF LEADING ZEROS SNL JMP NOTOBG /FIRST MAKING SURE THAT THE DESTINATION IS LARGER GETCH1 /IT AIN'T - WASTE A CHARACTER CLA ISZ DES1L /BUMP THE SOURCE LENGTH DOWN JMP TSD2SM /AND TRY AGAIN NOTOBG, DCA T1 JMP .+3 /MAY BE NO LEADING ZEROS TAD P21 PUTCHI ISZ T1 JMP .-3 JMP STALP /NOW TRANSFER THE DIGITS SUBST, AC4000 /SUBTRACT AND STORE - A TIME AND CORE SAVER ADDST, JMS I (DOADD /ADD AND STORE - DITTO JMP SHTCUT /TAKE THE SHORTCUT /ALPHA TO DECIMAL CONVERSION A2D, TAD P7400 DCA I (A2DKLG /A KLUDGE FOR KLODS POPNUM /GET THE ALPHA STRING AS A NUMBER TAD A2DSZA DCA I (A2DKLG /UNKLUDGE TAD AS SPA CLA JMP A2DERR /SIGN SHOULD BE POSITIVE, OTHERWISE ILLEGAL CHAR TAD ALAST DCA T1 /OF COURSE WE MAY HAVE SOME ILLEGAL DIGITS TAD ALAST /MIXED IN BECAUSE OF SIGNS DCA T2 TAD NUMLEN DCA T A2DLP, TAD I T1 DCA BS /SAVE THIS DIGIT DCA I T1 /AND ZERO IT TAD BS SPA JMP A2DSGN /NEGATIVE IMPLIES A SIGN (+ OR -) TAD (-12 SMA CLA /MAKE SURE ITS A LEGAL DIGIT JMP A2DERR /NO - ERROR TAD BS DCA I T2 /STORE IT BACK STA TAD T2 DCA T2 /BUMP STORE POINTER A2DCMN, STA TAD T1 DCA T1 /BUMP FETCH POINTER ISZ T JMP A2DLP /GO THROUGH ALL THE "DIGITS" SHTCUT, JMS STSETP /SET UP THE DESTINATION AND TRACE FLAG DCA T /ZERO THE "NON-ZERO" FLAG TAD PUTDL TAD ALAST /COMPUTE STARTING DIGIT DCA XR SKP SHTPUT, PUTCHI /PUT OUT THIS DIGIT TAD PUTDL CIA TAD NUMLEN SMA SZA CLA TAD (-20 /WATCH OUT FOR LARGE DESTINATIONS SNA TAD I XR /GET THE NEXT DIGIT FROM THE DECIMAL AC A2DSZA, SZA ISZ T /SET FLAG IF DIGIT NON-ZERO TAD P21 /CONVERT TO -237 ASCII ISZ PUTDL /LAST DIGIT? JMP SHTPUT /NOT YET DCA T1 /SAVE LAST DIGIT TAD T SZA CLA /ANY NON-ZERO DIGITS? TAD AS SPA CLA /IF SO, IS THE SIGN NEGATIVE? TAD (40 /YES - PUT A SIGN BIT OVER THE LAST DIGIT TAD T1 PUTCHI JMP STEXIT /CANCEL TRACE AND LEAVE A2DSGN, TAD (20 /IGNORE BLANKS SZA TAD (-13 /AND + SIGNS CLL RTR SZA /AND RECORD - SIGNS A2DERR, ERROR /ALL OTHER CHARACTERS ARE ILLEGAL RAR TAD AS DCA AS /UPDATE THE SIGN WORD JMP A2DCMN /AND CONTINUE / PAGE /INIT - INITIALIZE FILE I/O INIT, JMS I ZFETPC DCA T2 /GET I/O DEVICE AND DIRECTION TAD T2 TAD (-105 SNA CLA /ARE WE TRYING TO INIT THE LPT? TAD (JMP LPNOMT /YES WE ARE DCA LPTEST TAD T2 RAL SNL SMA CLA /DOES THE I/O DEVICE NEED A LABEL? JMP NOLABL /NO POPDS1 /TOP OF STACK DESCRIBES LABEL TAD (LABEL-1 DCA XR AC7775 /3 WORDS DCA T1 LGETLP, JMS I (LGETCH BSWN DCA T JMS I (LGETCH TAD T DCA I XR ISZ T1 JMP LGETLP NOLABL, JMS I (IOCOMN /GET FILE NUMBER TABLE ENTRY RAL SZL SPA CLA /IS THIS ALREADY BEING USED FOR FILE I/O? INIERR, FATAL /YES - ERROR (NON-MASS STORAGE I/O DOESN'T COUNT) TAD T2 /GET I/O DEVICE AND DIRECTION DCA I T /PUT IT IN THE TABLE TAD I T IAC /FOR "INIT(N,SYS)" COMMAND RAL SNL SMA CLA /IS IT A MASS STORAGE INIT? JMP I (CDINIT /NO - SEE IF IT'S IN USE LPTINI, CALL ZUSRCF TAD USRBAS TAD (BARRAY-1 DCA T1 /WE NEED A BUFFER FOR MASS STORAGE I/O TAD PROCN DCA ZMT1 DCA T2 GETBLP, ISZ T2 /BUMP IFN ISZ ZMT1 /COUNT BEFORE LOOK IN CASE ZERO BUFFERS SKP BUFERR, FATAL /NO MORE BUFFERS ISZ T1 TAD I T1 /CHECK FOR NONEXISTENT OR USED BUFFER SPA CLA /SIGN BIT OF BUFFER TABLE ENTRIES IS ON JMP GETBLP /IF THE BUFFER IS BEING USED FNDBUF, TAD T2 CALL ZPTRST CALL ZUSRCF AC4000 TAD LPTEST TAD I T RAL SNL SMA CLA AC4000 /TURN SIGN BIT ON FOR WRITE ONLY DCA W0 TAD T1 DCA AS /SAVE PTR TO BUFFER INFO CALL ZJOBIX /FETCH THE BUFFER BASE DESCRIPTOR BFRTBL DCA T1 CALL ZUSRCF /RESTORE TO USER FIELD AC7777 TAD T2 BSWN /TIMES 400 WORDS PER BUFFER CLL RTL TAD T1 AND P7400 /CLIP OFF FIELD BITS DCA W1 /PRESTO CHANGO! THE ADDRESS SZL /MAY HAVE CROSSED FIELD BOUNDARY TAD P10 TAD T1 AND P70 TAD P200 /# PAGES TO READ OR WRITE TAD W0 /ADD IN R/W BIT DCA W0 TAD I T RAL SNL SMA CLA /IS IT AN "INIT(N,SYS)"? TAD (SYSINI-MOUNT /YES NOISYS, TAD (MOUNT DCA INIRTN /SET UP FOR "INIT" CALL TAD LPTEST SZA CLA /IF LPT, BUFFER BITS GO IN 6-8 TAD T2 CLL RAL RTL SNA TAD T2 /ON ACCOUNT OF BECAUSE THE DEVICE # GETS BITS 9-11 TAD I T DCA T2 DCA I T /IN CASE HE HAS AN "ON ERROR" LABEL AC0001 /LOOKING FOR SEQUENCE # 1 DCA REELNO TAD LPTEST SNA CLA /LPT? JMP NOTLP1 /SKIP THE FOLLOWING IF NOT TAD LPTUNT /THE DRIVE # OF LPTSPL LOGICAL UNIT TAD W0 DCA LPTCTL DCA W0 /MAKE THE CHANNEL 'NOT INITED' TAD W1 DCA LPTADR DCA LPTHI /GUARANTEE 0 DCA LPTLO /SO CODE AT "CDQLPT" DOES A "GETSEG" LPTEST, 0 /BECOMES "JMP LPNOMT" IF LPT NOTLP1, PUSHJS INIRTN, 0 LPNOMT, CALL ZUSRCF TAD T2 DCA I T AC4000 DCA I AS /SET "BUFFER IN USE" BIT ON JMP I ZILOOP LPTUNT, 0 /GETS FILLED IN WITH DRIVE # AT STARTUP / PAGE /XMIT - DO SEQUENTIAL MODE I/O XMIT, TAD ZDES2 POPDES /GET THE BLOCK DESCRIPTOR JMS IOCOMN /GET THE FILE NUMBER TABLE ENTRY SNA /HAS IT BEEN INITIALIZED? XMIERR, FATAL /NO - ERROR RAL SMA SNL CLA /IS IT MASS STORAGE? CLA IAC /NO - USE CDOIO TAD (JMS I XRDOIO /YES - USE RDOIO DCA DOIO TAD DES2L CLL CML RAR /TURN THE BLOCK LENGTH INTO A WORD COUNT IAC DCA LENGTH /STORE IT AS THE MAXIMUM I/O LENGTH JMS DESFLD /EXECUTE CDF TO START OF RECORD TAD LENGTH DCA I DES2W /STORE THE BLOCK LENGTH IN THE BLOCK HEADER TAD LENGTH JMS XMICDF /SHARE SOME CODE AND X7700 /DUE TO A KLUDGE, WE MUST ZERO OUT THE LAST SZL /CHARACTER OF ANY BLOCK WITH AN ODD DCA I DES1W /LENGTH IN CHARACTERS CALL ZUSRCF /BUFFER MAY NOT BE IN SAME FIELD AS JOB AREA STA /CAUTION - AC MAY NOT BE ZERO HERE TAD DES2W DCA DOIOBF /GET THE BLOCK ADDRESS -1 FOR DOIO TAD I T CDF RSFLD AND P7 /GET THE IFN (RDOIO) OR DEVICE NUMBER (CDOIO) TAD DES2F TAD (-CDF /ADD IN THE FIELD OF THE BLOCK IN BITS 6-8 DOIO, HLT /EITHER "JMS I RDOIO" OR "JMS I CDOIO" DOIOBF, 0 JMP XMIEOF /END-OF-FILE - CLOSE FILE AND TAKE EOF RETURN JMS I ZFETPC X7700, SMA CLA /SKIP THE END OF FILE RETURN NORMALLY X101, 101 /"SMA" IS JUST TO GET 7700 - IGNORE IT JMS DESFLD /DO CDF TO WORD COUNT TAD I DES2W /CHECK NEW LENGTH AGAINST SPECIFIED LENGTH CMA TAD LENGTH DCA LENGTH TAD I DES2W JMS XMICDF SNA /SPECIAL CHECK FOR ENTIRELY NULL LINE JMP BLNKCN /BLANK IT OUT ENTIRELY AND P77 /IF THE LAST CHARACTER IS NULL, SNA CLA ISZ I DES1W /CONVERT IT TO A BLANK JMP BLNKSZ BLNKLP, ISZ DES1W /FILL IN THE REST OF THE RECORD WITH BLANKS JMP BLNKCN /NO SKIP, OK TAD P10 /IF WORD INDEX OVERFLOWS GOTO DESFLD JMS DESFLD /PLUS 10 - CANNOT OVERFLOW TWICE BLNKCN, TAD X101 DCA I DES1W BLNKSZ, ISZ LENGTH JMP BLNKLP ISZ LENGTH /FOR SAFETY JMP I ZILOOP XMIEOF, JMS DESFLD TAD I DES2W /BLOCK HEADER WILL TELL WHAT HAPPENED SPA CLA /IF ITS NEGATIVE, LTLERR, ERROR /IT MEANS THAT THE RECORD WAS TOO LONG TO FIT /OTHERWISE IT WAS AN END-OF-FILE CALL ZUSRCF TAD I T /JUMP INTO THE "FINI" PROCESSOR JMP FINI1 /WHICH WILL THEN GO TO THE EOF RETURN XMICDF, 0 /CALL TO COMPUTE CDF TO LAST CHAR IN RECORD CIA /OR READ INTO DEPENDING ON AC AT ENTRY CLL TAD DES2W /ADDING EITHER LENGTH OR WC TO START OF RECORD DCA DES1W /CALLERS EXPECT THIS SZL /IF CARRY INTO LINK, LAST CHAR IS ACCROSS TAD P10 /FIELD BOUNDARY SO GET DF POINTING AT IT JMS DESFLD /BEFORE RETURN. TAD DES2L /ALSO SET LINK TO SHOW ODD OR EVEN RECORD LENGTH RAR CLA TAD I DES1W /BOTH CALLERS NEED THIS EXIT XMICDF DESFLD, 0 /AC=0 OR 10 TAD DES2F DCA .+1 HLT EXIT DESFLD /FINI - TERMINATE I/O OPERATIONS ON A FILE FINI, JMS IOCOMN /GET THE FILE NUMBER TABLE ENTRY FINI1, RAL SNL SMA CLA /IS IT A MASS STORAGE FILE? JMP I (CDFINI TAD I T AND P7 /GET THE INTERNAL FILE NUMBER (IFN) PUSHJS /TERMINATE BUFFERS AND REWIND TAPES, IF NECESSARY CLOSE LPTJMP, CALL ZUSRCF TAD I T SZA /IF LPT, CDFINI HAS ALREADY CLEARED THIS JMP NOTLPT TAD IOCOMN /AND PUT WHAT WAS IN TABLE INTO "IOCOMN" RAR RTR /AND FOR LPT, BUFFER INFO IS IN BITS 6-8 NOTLPT, AND P7 /GET THE IFN AGAIN TAD USRBAS TAD (BARRAY-1 DCA T1 /FORM A POINTER INTO THE BUFFER TABLE DCA I T1 /MARK THE BUFFER FREE TAD I T /THIS MAY ALREADY BE 0... DCA IOCOMN /TEMP SAVE THIS DCA I T /MARK THIS FILE NUMBER UNINITIALIZED TAD IOCOMN SZA CLA /IF LPT, WORD POINTED TO BY T IS ALREADY 0 JMP I ZILOOP JMP I (LPTEOF /WE'RE CLOSING LPT - DO THE THING IOCOMN, 0 /ROUTINE TO GET THE FILE NUMBER TABLE ENTRY DBCONV /CONVERT THE TOP OF STACK NUMBER TO BINARY AND P17 /FORCE IT LEGAL TAD USRBAS TAD (FARRAY-1 /ADD THE BASE OF THE TABLE DCA T /TO FORM A POINTER CALL ZUSRCF TAD I T /LOAD THE ENTRY INTO THE AC JMP I IOCOMN /RETURN / PAGE /RANDOM DIBOL OPERATIONS HEREDC, JMS I (FETPC /HERE WE ARE JMP DCALIN LININC, TAD T /SHORT FORM OF "HEREDC" - USED IF DIFFERENCE CIA TAD LINENO /BETWEEN THIS LINE NUMBER AND PREVIOUS ONE DCALIN, DCA LINENO /IS LESS THAN 512 TAD (PUTJMP DCA TRCJMP TAD TRCFLG SZA CLA /EXECUTE PUSHJS IF TRACE ENABLED PUSHJS ATLINE /GETS EXECUTED IF NOT SO KEEP ROUTINE BELOW 2000 IFZERO ATLINE-1777&4000 /LOST AGAIN, DIDN'T YOU? JMP I ZILOOP /WILL DO CLA FORMS, DBCONV /GET SECOND ARGUMENT CIA DCA LFCTR /SAVE IT TAD BS AND (40 DCA AS /SAVE SIGN OF NUMBER JMS I (IOCOMN /GET FILE NUMBER TABLE ENTRY AND (7707 /WORD FOR LPT HAS IFN BITS IN 6-8... TAD (-105 SZA CLA /IS THE DEVICE THE LINE PRINTER? JMP I ZILOOP /NO - FORMS CONTROL MEANINGLESS TAD AS SZA CLA JMP CNTRNX /NEGATIVE MEANS SPECIAL FORMS CONTROL TAD LFCTR SNA CLA /A ZERO ARGUMENT MEANS A FORM FEED IS NEEDED JMP FFOUT /OTHERWISE MULTIPLE LINE FEEDS ARE DESIRED MULTLF, AC7776 /CONVERT 214 TO 212 PUSHJS FRMOUT ISZ LFCTR JMP MULTLF JMP I ZILOOP CNTRNX, TAD LFCTR CLL CMA RTL /MAGIC TRANSFORMATION TAD LFCTR FFOUT, PUSHJS FRMOUT JMP I ZILOOP FFREC, 0001 /A WC OF +1 WILL OUTPUT 4095 WORDS, YOU SAY? FFCHAR, 0 /LOOK AT "CDQLPT" FRMOUT, TAD (214 /AC MAY BE NON-ZERO DCA FFCHAR TAD (15 CALL XCDOIO /OUTPUT ONE WORD RECORD FFREC-1 FRMERR, ERROR /OUT OF ROOM - CAN BE MUCHO BAD POPJS /YOU DID CALL WITH PUSHJS, RIGHT? DOADD, 0 /COMMON ROUTINE FOR ADD, SUBTRACT, AND COMPARE DCA BS /SAVE SIGN DIDDLE POPNUM /GET ADDEND (OR SUBTRAHEND) FROM STACK TAD AS TAD BS DCA AS /DIDDLE ITS SIGN TAD T DCA QDIGIT /SAVE THE NUMBER OF DIGITS AC0002 POPNUM /GET THE OTHER NUMBER TAD T CIA TAD QDIGIT /FIND THE LARGER OF THE TWO LENGTHS SPA CLA TAD T TAD NUMLEN /AND TRANSFORM IT INTO A DIGIT IGNORE COUNT CMA JMS I (ADDAB /WHICH WE USE TO SHORTEN THE ADD TIME JMP I DOADD /RETURN /PUSH A SUBSTRING DESCRIPTOR ONTO THE STACK PUSH2S, DBCONV /GET THE UPPER CHARACTER NUMBER DCA DOADD DBCONV /GET THE LOWER CHARACTER NUMBER DCA T TAD T CIA CLL TAD DOADD /MAKE SURE THE LOWER LIMIT IS NOT ZERO SNL /OR GREATER THAN THE UPPER LIMIT P2ERR, FATAL CLL RTL SZL SPA /CHECK FOR LENGTH > 512 JMP P2ERR /YES - ERROR RAL TAD P10 /BUMP DIFFERENCE BY 1 TO GET REAL LENGTH DCA T1 TAD IST1 AND P7 TAD T1 DCA IST1 /FORM A NEW DESCRIPTOR STA CLL CML /AND AN ADDRESS EQUAL TO THE ADDRESS JMP I (BUMPID /OF THE ITEM OFFSET BY THE LOWER LIMIT (-1) ROUND, DBCONV /ROUND A NUMBER N DECIMAL PLACES AND P7 /CRUDE LIMIT ON N CMA DCA T DCA I B /PROTECTION IF N=0 JMP .+3 DCA I A /MOVE ACCUMULATOR A RIGHT N PLACES ISZ A /ZEROING THE HIGH ORDER DIGITS ISZ T JMP .-3 POPNUM /LOAD THE ROUNDEE INTO THE STRANGE AC TAD (ACA DCA A /RESTORE SANITY TAD I B /GET THE FIRST OVERFLOW DIGIT JMP I (RNDADD /CONTINUED ON ANOTHER PAGE / PAGE BLKCON, 0 DCA IST1 /WE MUST NOW MULTIPLY THE RECORD SIZE BY THE DCA IST2 /RECORD NUMBER TO OBTAIN A WORD ADDRESS AC7776 AND DES2L DCA DES2L /FORCE LENGTH EVEN JMP MDIGIT MSHFT, TAD IST1 DCA T1 TAD IST2 DCA T2 /WE HAVE TO MULTIPLY (IST1,IST2) BY 10 JMS RLEFT JMS RLEFT TAD IST2 CLL TAD T2 DCA IST2 RAL TAD IST1 TAD T1 DCA IST1 JMS RLEFT /DONE MDIGIT, GETCH1 /GET A DIGIT OF THE MULTIPLIER TAD (-20 CIA DCA QDIGIT /TURN IT INTO A COUNT (0=-1,1=-2,ETC.) JMP ISZCNT MADDLP, CLL /WE HAVE TO ADD IN THE RECORD SIZE TAD IST2 /TO THE PRODUCT AS MANY TIMES TAD BLKSIZ /AS THE VALUE OF THE MULTILIER DIGIT DCA IST2 SZL ISZ IST1 /IN DOUBLE PRECISION, OF COURSE ISZCNT, ISZ QDIGIT JMP MADDLP ISZ DES1L /ITERATE FOR THE NUMBER OF DIGITS IN THE MULTIPLIER JMP MSHFT CALL (IOCOMN CMA AND RAT1 /UNIT MUST BE OF TYPE "UPDATE" FOR WRITE SZA CLA /AND OF TYPE "INPUT" OR "UPDATE" FOR READ CDRINI, RAERR, FATAL /WRONG TYPE OF UNIT TAD I T /GET EDP-8 UNIT NUMBER AND P7 JMS I ZPTRST /SET UP POINTERS TO FCB ENTRY TAD W0 /GET BUFFER CONTROL WORD CLL RAL AND P7400 DCA BUFSIZ /STORE BUFFER SIZE TAD BLKSIZ CIA CLL /SUBTRACT ONE FROM THE RECORD NUMBER TAD IST2 /AFTER THE MULTIPLICATION, UNFORTUNATELY DCA IST2 SNL STA TAD IST1 DCA IST1 /WATCH THOSE CARRIES! CLL /ADD 400 TO THE PRODUCT TO BUMP THE WORD ADDRESS TAD (400 /BY THE LENGTH OF THE DEVICE LABEL RECORD TAD IST2 DCA RELBLO /THIS PRODUCT NOW HAS TO BE BROKEN UP RAL TAD IST1 /INTO AN INTEGRAL MULTIPLE OF THE I/O BUFFER DCA RELBHI /SIZE AND A REMAINDER. TAD (-15 /TO ACCOMPLISH THIS WE DO A PSEUDO-DIVIDE DCA QDIGIT /BY THE BUFFER SIZE (ALL WE NEED IS THE REMAINDER SKP DIVLP, JMS RLEFT /SHIFT (IST1,IST2) LEFT 1 TAD BUFSIZ CIA CLL TAD IST1 SZL /IF BUFSIZ .LT. IST1, IST1=IST1-BUFSIZ DCA IST1 SZL CLA /IF SUBTRACT SUCCEEDED KEEP TRYING JMP DIVLP+1 /THIS HANDLES CASE OF IST1>2*BUFSIZ ISZ QDIGIT JMP DIVLP /ITERATE UNTIL IST2 IS TOTALLY SHIFTED IN TAD IST1 /NOW SUBTRACT THE REMAINDER FROM THE WORD ADDRESS /TO LEAVE AN INTEGRAL MULTIPLE OF BUFSIZ CIA CLL TAD RELBLO DCA RELBLO SNL STA /DECREMENT HIGH ORDER ON OVERFLOW (UNDERFLOW?) TAD RELBHI DCA RELBHI CLL TAD RELBHI TAD U2 /COMPARE HIGH-ORDER ADDRESS AGAINST DEVICE LENGTH SZL CLA JMP I (RECERR /RECORD NUMBER WAY TOO LARGE EXIT BLKCON /RANDOM ACCESS I/O WRITE, CLA IAC /RANDOM ACCESS WRITE READ, STL RTR /RANDOM ACCESS READ DCA RAT1 /SAVE READ/WRITE FLAG IN SIGN POPDS1 /GET RECORD NUMBER TAD ZDES2 POPDES TAD DES2L CLL CMA RAR IAC /GET RECORD LENGTH IN WORDS DCA BLKSIZ /STORE THAT, TOO JMS BLKCON /COMPUTE BUFFER NUMBER JMP I (RDBLKX RLEFT, 0 /SHIFT (IST1,IST2) LEFT 1 TAD IST2 CLL RAL DCA IST2 TAD IST1 RAL DCA IST1 JMP I RLEFT BUFINC, 0 ISZ W2 NOP TAD W2 CMA SZA CLA EXIT BUFINC CIF 0 CALL (COPOUT EXIT BUFINC / PAGE /RANDOM ACCESS I/O - PAGE 2 AND (7700 /PULL A JIM D-ISM *.-1 RDBLKX, TAD W5 AND OPT377 TAD RELBLO DCA W5 /SET UP THE BLOCK NUMBER IN THE FILE CONTROL BLOCK TAD RELBHI DCA W4 JMS I KGPBUF /DO THE I/O AND BUMP THE BLOCK NUMBER DONTRD, TAD W1 AND P7600 TAD IST1 TAD M1 /COMPUTE THE BUFFER POINTER FROM THE REMAINDER DCA W2 /OF THE DIVISION TAD BUFSIZ CIA TAD IST1 /LIKEWISE COMPUTE THE NUMBER OF WORDS LEFT DCA W3 /IN THE BUFFER TAD RAT1 /GET THE READ/WRITE FLAG SPA CLA /WHAT IS IT? JMP RAOUTP /WRITE STA /RANDOM ACCESS INPUT - USE RDOIO TAD DES2W DCA RAIOBF TAD BLKSIZ CIA IAC /WE DON'T DO EXACT LENGTH CHECKING ON READS, DCA LENGTH /BUT WE DO CHECK FOR INPUT RECORD TOO BIG CALL ZUSRCF TAD I T CDF RSFLD AND P7 /GET EDP-8 FILE NUMBER TAD DES2F TAD (-CDF /ADD IN BLOCK FIELD BITS JMS I XRDOIO RAIOBF, 0 JMP RECERR /EOF OR BUFFER TOO LONG JMP I ZILOOP /RANDOM ACCESS WRITE NITTY GRITTY RAOUTP, TAD W2 DCA XR2 /GET POINTER INTO BUFFER CALL (CDFBFR /DO CDF TO BUFFER FIELD STA TAD I XR2 TAD BLKSIZ /MAKE SURE WE'RE OVERWRITING A RECORD SZA CLA /OF THE CORRECT LENGTH RECERR, ERROR /NO - BAD JMP RABUMP /BUMP COUNTERS SINCE WE'RE SKIPPING A WORD RACDL, ISZ DES2W /USE DES2W DIRECTLY AS WORD POINTER JMP RAFOK /OK, NO MEMORY FIELD CHANGE TAD P10 /ON OVERFLOW MUST CHANGE CDF TO NEXT FIELD TAD DES2F DCA DES2F /SAVE RESULT IN SAFE PLACE RAFOK, TAD DES2F DCA .+1 HLT /CDF TO NEXT WORD IN RECORD TAD I DES2W /FETCH IT CALL (CDFBFR DCA I XR2 /STORE A WORD CDF RSFLD /CDF TO THIS FIELD RABUMP, ISZ W3 /BUMP THE BUFFER WORD COUNT JMP RAWRLP /NO SWEAT - KEEP GOING PUSHJS SETWR /SET FILE TO WRITE & DIDDLE BLOCK NUMBER JMS I KGPBUF /AND READ THE NEXT BUFFER TAD W2 DCA XR2 /INITIALIZE XR2 TO START OF NEW BUFFER RAWRLP, ISZ DES2L /BUMP CHARACTER COUNT ISZ DES2L /BUMP IT TWICE - ITS EVEN JMP RACDL TAD XR2 DCA W2 /UPDATE THE BUFFER POINTER (FOR NO GOOD REASON) PUSHJS SETWR /SET THE FILE TO AN OUTPUT FILE /THIS SERVES AS A FLAG THAT A WRITE IS PENDING JMP I ZILOOP /THE WRITE WILL ALWAYS BE DONE /RANDOM ACCESS SUBROUTINES / APOLOGIES TO R.L. FOR RIPPING OUT ALL HIS GOOD CODE SETWR, TAD W0 CLL RAL /R/W BIT INTO THE LINK AND P7400 /GET BLOCK COUNT IN AC0-3 CIA /THIS LEAVES LINK ALONE! TAD W5 DCA W5 /DECREASE THE BLOCK NUMBER BY THE SNL /BUFFER LENGTH STA TAD W4 /TO REFLECT THE CURRENT BUFFER ADDRESS DCA W4 /INSTEAD OF THE NEXT BUFFER ADDRESS ON THE DEVICE AC4000 TAD W0 /SET WRITE MODE FOR GPBUF DCA W0 /MUST ALWAYS DO I/O FOLLOWING JMS I KGPBUF /A 'WRITE' TO PREVENT UPDATE CONFLICTS AC3777 AND W0 /SET BACK TO READ MODE DCA W0 POPJS /"JMP I SETWR" ONLY BETTER OPTSET, TAD (LDBUF+10 DCA XR1 STA DCA I XR1 /FAKE WORD COUNT CDF 00 TAD I (SWITCH AND P77 KLG40, SZA TAD KLG40 /CONVERT STRIPPED SIXBIT IAC /TO -237 SIXBIT AND P77 /WITH SPECIAL HACK FOR BLANK DCA T TAD I (SWITCH OPT377, AND (7700 SZA TAD (4000 TAD (100 TAD T CDF RSFLD JMP I (OPTDAT LPKLG2, TAD (LPTLO-1 PUSHJS DKDOIT /THIS REALLY OUGHT TO GO THROUGH "SPLDEV" DCA LPTHI /0 SO CODE AT CDQLPT WILL DO A "GETSEG" DCA LPTLO CIF CDF 0 JMP I (LPUNK2 / PAGE /ERROR ROUTINE PERLST, ERRLST ERRORX, 0 /ERROR ROUTINE CDF RSFLD CLA TAD ERRORX DCA FATALX TAD USRERR SNA /USER ERROR ON THIS LINE? JMP GTEROV /NO - GET ERROR OVERLAY DCA T DCA USRERR /KILL USER ERROR WORD TAD OLDPDL DCA PDL /RESTORE PUSHDOWN POINTER JMP I (ILOOPE /EXECUTE USRERR , WHICH IS A BRANCH FATALX, 0 /FATAL ERROR ROUTINE GTEROV, CDF RSFLD CLA TAD (ERRLST DCA PERLST ERRLP, TAD I PERLST ISZ PERLST TAD FATALX /FIND OUT WHERE WE WERE CALLED FROM SNA CLA JMP ERRFND ISZ PERLST JMP ERRLP ERRFND, TAD I PERLST /GET POINTER TO ERROR MESSAGE DCA ERMESG CALL (CTRLOF AC0001 /ERROR MESSAGES IN FIELD 0 JMS I XCDOIO /PUT THE MESSAGE OUT ON THE TTY ERMESG, 0 XXX PUSHJS ATLINE STOP, TAD PROCN /HAVE TO CLEAR OUT ALL THE FILES DCA STCTR DCA TIFN STLOO, ISZ STCTR SKP JMP I (KILLIT /DO THE REST DOWNSTAIRS ISZ TIFN TAD TIFN CALL ZPTRST TAD W0 /ANYTHING THERE? SNA CLA JMP STLOO PUSHJS CLOSRD JMP STLOO LOCK, CALL (IOCOMN /GET CHANNEL # FROM DESCRIPTOR ON STACK CLL RAL SNL SMA JMP LOKEND /LOCK ON CDOIO CHANNEL IS NOP JMS LOKJOB /FILE OK TO LOCK? JMP I ZILOOP /NO, EXECUTE ERROR BRANCH SPA CLA /IS ALREADY LOCKED BY THIS JOB? JMP LOKEND /YES CDF 00 TAD I (JOB /OK, GET THE JOB # TAD (40 /SET LOCK BIT ON BSWN CDF RSFLD TAD I WXI DCA I WXI /ADD TO REEL # AND STORE LOKEND, CLA JMS I ZFETPC /REMOVE ERROR BRANCH JMP I ZILOOP UNLOCK, CALL (IOCOMN /GET I/O CONTROL WORD CLL RAL SMA SNL /MASS STORAGE? JMP I ZILOOP /NO, IGNORE UNLOCK JMS LOKJOB /OK TO UNLOCK? JMP I ZILOOP /NO, LOCKED BY SOMEONE ELSE AND P77 /OK, CLEAR OFF TO REEL # DCA I WXI JMP I ZILOOP / ROUTINE TO EXAMINE FILE LOCK ENTRY IN LOGICAL UNITS TABLE. / CALL WITH AC = RESULT OF: / TAD I T1 ;FARRAY ENTRY FOR THIS CHANNEL / CLL RAL / / JMS LOKJOB / ;FILE LOCKED BY SOME OTHER JOB / ;FILE UNLOCKED OR LOCKED BY THIS JOB / AC=CONTENTS OF LOCK ENTRY / LOKJOB, 0 RAR /RESTORE T1 (FARRAY ENTRY) AND P7 /CLIP OFF GORP TO GET IFN CALL ZPTRST /SET UP FILE TABLES JMS WXIDX /GET VECTOR TO LOCK ARG FOR L.U. LOKARG-SYSPFT+1 SMA /LOCK ON? JMP LOKOK /NO, OK TO LOCK BSWN AND (37 / JOB = 37 MEANS RECORD LOCK CIA CDF 00 /COMPARE JOB #'S TAD I (JOB CDF RSFLD SZA CLA /SAME JOB? JMP I LOKJOB /NO, YOU LOSE LOKOK, ISZ LOKJOB /OK, TAKE SKIP RETURN CLA TAD I WXI /WITH LOCK TABLE ENTRY EXIT LOKJOB FLDOVR, 0 CDF RSFLD DCA FLDTEM /FIELD JUST OVERFLOWED TAD I FLDOVR /CHAR IN AC ISZ FLDOVR /POINTER TO "PERMANENT CDF" DCA FLDPNT /FOLLOWS CALL TAD I FLDPNT TAD P10 DCA I FLDPNT TAD FLDTEM EXIT FLDOVR FLDTEM, 0 FLDPNT, 0 LABEL, 0; 0; 0 WXIDX, 0 /CALL WITH DISPLACEMENT FROM HEAD OF L.U. TAD WX /ENTRY+1 TO GET ARG IN AC AND POINTER TAD I WXIDX /TO ARG IN WXI DCA WXI ISZ WXIDX TAD I WXI EXIT WXIDX / PAGE / END SECTION 2 LISTING CONTROL IFNZRO LIST&4 //////////////////////////////// / / / END OF MULTI2.PA / / / ////////////////////////////////