Directory of image this file is from
This file as a plain text file
/MARK SENSE BATCH AND PIP JANUARY 9, 1974 / / / / AUTHOR: / MARK B. ROSENTHAL / DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY /DIGITAL. / / / / / / / / / / / /
L7775=CLA CLL CMA RTL L7776=CLA CLL CMA RAL L7777=CLA CLL CMA L0002=CLA CLL CML RTL L0001=CLA CLL IAC CONTCH=3 /CONTINUATION CHARACTER RUBOUT=7 /RUBOUT BITS JOBBIT=0200 /BIT POSITION OF $JOB IN COLUMN 1 EOFCHR=6004 /END OF FILE CARD CHARACTER IS _ TABCHR=6010 /TAB CHARACTER FFCHR=3010 /FORM FEED CHARACTER NOCHR=6400 /# CHARACTER RCSE=6672 /CARD READER SELECT AND SKIP IF READY RCSD=6671 /CARD READER SKIP IF CARD DONE RCRD=6674 /CARD READER CLEAR CARD DONE FLAG RCSF=6631 /CARD READER SKIP IF DATA READY RCRB=6634 /CARD READER READ BINARY KCF=6030 /CLEAR KEYBOARD FLAG SYSNO=CLA CLL IAC /OS8 DEVICE NUMBER FOR SYS: DSKNO=CLA CLL CML RTL /OS8 DEVICE NUMBER FOR DSK: FETCH=1 LOOKUP=2 ENTER=3 CLOSE=4 DECODE=5 CHAIN=6 USRIN=10 USROUT=11 F0=0 F1=10 JSBITS=7746 /JOB STATUS WORD *10 XR1, 0 XR2, 0 XRCDR, 0 XROPT, 0 *20 ERROR=JMS I .; XERR CONVRT=JMS I .; XCONVR OUT=JMS I .;OUTAD, XOUT SAVFLD=JMS I .;XSAVDF USR=JMS I .; 200 KEYWD, 0;0;0;0 TEMP1, 0 TEMP2, 0 TEMP3, 0 TEMP4, 0 TEMP5, 0 OPTCNT, 0 /OUTPUT BUFFER COUNT OPTSW, 0 /OUTPUT BUFFER THREE WAY SWITCH KEYADR, 0 KEYVAL, 0 ERRFLG, 0 ERRCNT, 0 CONFLG, 0 LNCNT, 0 USRFLG, 0 OFILE, ZBLOCK 5 /OUTPUT FILE DEVICE, LENGTH, AND NAME CDRFLG, -1 /CDRIN TO PASSES LAST CARD IF 0 BCLSW, 0 CDREOF, -1 DEVENT, 0 /ENTRY ADDRESS OF OUTPUT DEVICE HANDLER IOERR, 0 /ERROR NUMBER VERNO9, ISZ IOERR IOER8, ISZ IOERR CDRER7, ISZ IOERR OPTER6, ISZ IOERR OPTER5, ISZ IOERR OPTER4, ISZ IOERR OPTER3, ISZ IOERR OPTER2, ISZ IOERR OPTER1, JMP I .+1 IOERR1
*200 START, ISZ USRFLG;SKP /IS THE USR IN CORE? JMP CD /YES CIF 10;JMS I (7700;USRIN /LOCK USR IN CORE CD, L7777 /SET FLAG FOR USR IN CORE DCA USRFLG CIF 10;USR;DECODE;0 /DELETE TENTATIVE FILES TAD (7577 /COPY OUTPUT FILE #1 (NAME AND DEVICE) DCA XR1 CDF F1 TAD I (7644 /TEST /V SWITCH AND (4 SZA CLA JMP VERNO9 /YES - PRINT VERSION NUMBER TAD I XR1 SNA /IF NOT SPECIFIED, DSKNO /USE DEVICE DSK: DCA OFILE TAD I XR1 SNA /WAS A NAME GIVEN? JMP OPTER1 /NO INIT1, DCA OFILE+1 TAD I XR1 DCA OFILE+2 TAD I XR1 DCA OFILE+3 TAD I XR1 DCA OFILE+4 TAD (OFILE+1 DCA BLOKNO /SET FILE NAME ADDRESS TAD I (7605 /GET SECOND OUTPUT DEVICE SPECIFICATION DCA I (7600 /MOVE TO FIRST FOR SPOOLING IN BATCH CDF TAD BLOKNO /GET ADDRESS OF FILE NAME DCA I (CLOSNM /AND SAVE FOR CALL TO CLOSE TAD (OPTDEV&7600+1 /SET DEVICE HANDLER SPACE DCA DEVHDL TAD OFILE CIF 10;USR;FETCH /FETCH DEVICE HANDLER DEVHDL, OPTDEV&7600+1 /2 PAGES JMP OPTER2 /ERROR - CANNOT FETCH HANDLER TAD DEVHDL /MOVE ENTRY ADDRESS DCA DEVENT /TO PAGE ZERO TAD OFILE /ENTER THE FILE NAME AS TENTATIVE CIF 10;USR;ENTER BLOKNO, OFILE+1 /FILE NAME, STARTING BLOCK RETURNED HERE FILLEN, 0 /RETURNS FILE LENGTH HERE JMP OPTER3 /CANNOT ENTER FILE CIF 10;USR;USROUT /DISMISS THE USR DCA USRFLG /CLEAR USR IN CORE FLAG CDF 10 TAD BLOKNO /SAVE STARTING BLOCK NO. FOR BATCH DCA I (7620 TAD OFILE /SAVE DEVICE NO. FOR BATCH AND (17 DCA I (7617 TAD I (7643 /GET OPTIONS CDF F0 AND (2100 / /B OR /F SNA DCA I (EOFJMP /IF NEITHER, THEN WE CHAIN TO BATCH CLL RTL /GET /B OUT OF AC SZA CLA /IF AC=0 START WITH BASIC KEYWORDS TAD (FORKEY-BASKEY TAD (BASKEY-15 DCA KEYADR JMP I (INIT5 PAGE
INIT5, TAD (BPRI2 /TAILOR IT FOR BATCH PROCESSING DCA I (BPRKEY /"PRINT #4," TAD (BINP2 DCA I (BINKEY /"INPUT #3," TAD (BSTO2 DCA I (BSTKEY /"CLOSE# 4\STOP" TAD (BEND2 DCA I (BENKEY /"CLOSE #4\END" CDF F1 DCA I (CBAS5 /NO JUMP DCA I (DATL48 /NO JUMP TAD (CL2M1A /".R LOADER_*GENIOX" DCA I (CL2SX TAD I (7643 /TEST /I OPTION (INTERACTIVE) AND (10 SNA CLA JMP INIT6 TAD BASJMP /SET UP FOR FILES 0 & 1 DCA I (CBAS5 /SET UP THE JMP TAD BASJM1 /SET UP JUMP DCA I (DATL48 TAD (CL2M1 /".R LOADER_*" DCA I (CL2SX CDF F0 TAD (BPRI DCA I (BPRKEY TAD (BINP DCA I (BINKEY TAD (BSTO DCA I (BSTKEY TAD (BEND DCA I (BENKEY INIT6, CDF 10 TAD I (7644 /TEST /T OPTION AND (20 SNA CLA TAD (BATLPT-BATTTY TAD (BATTTY CIF CDF F1 JMS I (MOVODV TAD I (7645 /TEST /2 OPTION AND (200 SNA CLA JMP INIT3 TAD (CF2 /FORTRAN 2 DCA I (FORADR TAD (CL2 DCA I (LOAADR TAD (DATX2 JMP INIT4 INIT3, TAD (CF4 /FORTRAN 4 DCA I (FORADR TAD (CL4 DCA I (LOAADR TAD (DATX4 /INITIALIZE $DATA INIT4, DCA I (DATFTN TAD I (DATFTN DCA I (DATADR TAD (SAVARA DCA I (SAVPNT DCA I (NAMCNT CDF F0 DCA BCLSW /NO BCL CARDS YET L7777 DCA CDREOF /RESET EOF SWITCH TAD I (BLOKNO /SET STARTING BLOCK NUMBER DCA I (OPTBLK TAD (OPTBUF-1 DCA XROPT TAD (-200 DCA OPTCNT L7775 DCA OPTSW DCA ERRCNT /CLEAR COUNT OF CARDS IN ERROR JMP I (READY BASJMP, JMP CBAS7&177+INIT5 BASJM1, JMP DATL49&177+INIT5 PAGE
READY, JMS I (CDRIN /READ A CARD JMP I (EOF /END OF FILE SENSED TAD I XRCDR /GET COLUMN 1 DCA KEYWD /SAVE AS KEYWORD BITS TAD XRCDR DCA XR2 /TRANSLATE LINE NUMBER TAD (-5 DCA TEMP1 DCA LNCNT /CLEAR COUNT DCA KEYWD+3 /CLEAR COLUMN 2-6 KEYWORD BITS LNLP, TAD I XRCDR /GET LINE NO. COLUMN DCA TEMP2 /SAVE CHAR TAD (6000 AND TEMP2 /GET KEYWORD BITS CLL RAL RTL TAD KEYWD+3 CLL RTL DCA KEYWD+3 TAD (1777 AND TEMP2 /GET CHAR SNA JMP LNLPEN /IGNORE BLANKS CONVRT /TRANSLATE JMP LNLPEN /IGNORE RUBOUTS TAD (-"9 SMA SZA JMP LNERR /NOT A NUMBER TAD ("9-"0 SPA JMP LNERR /NOT A NUMBER TAD ("0 LNLP1, DCA I XR2 /INSERT CHARACTER IN OUTPUT BUFFER ISZ LNCNT /COUNT THIS CHARACTER LNLPEN, ISZ TEMP1 /GOT ALL LINE NUMBER COLUMNS? JMP LNLP /NO - LOOP. JMP I (KEYTRA /GO TRANSLATE KEYWORD LNERR, ERROR JMP LNLP1 MAKNA2, 0 /FIELD 1 OUTPUT ROUTINE FOR MAKNAM CIF CDF F1 JMS I (MAKNA3 JMP I MAKNA2 OOUT2, 0 OUT CIF CDF F1 JMP I OOUT2 GETCD1, 0 TAD I XRCDR CIF CDF F1 JMP I GETCD1 /FOR RETURN TO CALLING FIELD /PRESERVES AC AND LINK WHILE PUTTING /CIF CDF TO DATA FIELD AT ADDRESS /SPECIFIED AS FIRST WORD AFTER CALL XSAVDF, 0 DCA XSAVD1 RDF TAD (CIF CDF DCA XSAVD2 CDF TAD I XSAVDF ISZ XSAVDF DCA XSAVD3 TAD XSAVD2 DCA I XSAVD3 TAD XSAVD1 JMP I XSAVDF XSAVD1, 0 XSAVD2, 0 XSAVD3, 0 PAGE
XERR, 0 K7600, 7600 TAD ("? /OUTPUT A "?" ISZ ERRFLG /FLAG ERROR ON THIS CARD JMP I XERR TIME=12 CDRIN, 0 /READ A CARD INTO THE BUFFER SAVFLD;CDRCIF /SAVE DATA FIELD FOR RETURN DCA ERRFLG /CLEAR ERROR FLAG FOR THIS CARD ISZ CDREOF /HAVE WE SEEN EOF? JMP CDRCIF /YES - STILL EOF ISZ CDRFLG /SHOULD WE PASS LAST CARD? JMP REINIT /YES CDRIN6, JMS CDRIN5 /RESET TIME OUT COUNTERS TAD (-50 /YES - READ IT INTO THE CDR BUFFER DCA TEMP1 /40 COLUMNS (DECIMAL) TAD (CDRBUF-1 DCA XRCDR CDRIN3, RCSE /CARD READY? JMP CDRIN4 /TEST TIME OUT JMS CDRIN5 /RESET TIME OUT COUNT CDRIN1, JMS KBRD /TEST KEYBOARD (AFTER TIME OUT LOOP) RCSD /CARD DONE? SKP JMP CDRIN7 /YES - TOO FEW COLUMNS RCSF /CHARACTER READY? JMP CDRIN1 /NO - TRY CARD DONE JMS CDRIN5 /RESET TIME OUT COUNT RCRB /YES - READ BINARY CDRIN2, DCA I XRCDR /AND STORE IT ISZ TEMP1 /DON'T READ MORE THAN BUFFER CAN HOLD JMP CDRIN1 /TRY CARD DONE AGAIN RCSD /WAIT FOR END OF CARD - OR ELSE! JMP .-1 RCRD /IF THIS ISN'T CLEARED, /FORTRAN IV BECOMES VERY UNHAPPY! JMP CDRIN8 CDRIN7, RCRD /FORTRAN IV AGAIN ISZ TEMP1 /ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL) JMP CDRER7 /ERROR! DCA I XRCDR CDRIN8, TAD (CDRBUF-1 /INIT BUFFER POINTERS AGAIN DCA XRCDR TAD (-50 DCA TEMP1 TAD (-EOFCHR /TEST FOR FIRST COLUMN=EOFCHR AND REST =0 EOFLP, TAD I XRCDR /GET NEXT COLUMN SZA CLA JMP REINIT /NON-ZERO - NOT EOF ISZ TEMP1 JMP EOFLP /LOOP JMP CDRCIF /END OF FILE CARD REINIT, TAD (CDRBUF-1 DCA XRCDR ISZ CDRIN /SKIP RETURN IF NOT EOF L7777 /RESET EOF SWITCH CDRCIF, 0 DCA CDREOF L7777 /SET TO READ A NEW CARD NEXT TIME DCA CDRFLG JMP I CDRIN CDRIN4, JMS KBRD /TEST TIME OUT JMP CDRIN3 /TRY SELECTING CARD AGAIN CDRIN5, 0 /RESET TIME OUT DCA TIMOUT TAD (-TIME DCA TIMOU2 JMP I CDRIN5 KBRD, 0 KSF /KEYBOARD? JMP KBRDTM /NO - TIME KRS /IS IT ^C? AND (177 TAD (-3 SNA CLA JMP I K7600 /YES - RETURN TO OS-8 KBRDTM, ISZ TIMOUT /TIMED OUT YET? JMP I KBRD /NO ISZ TIMOU2 JMP I KBRD /LIKEWISE KCF /IGNORE ANYTHING TYPED BEFORE THIS TAD (207 /NOTHING - WAKE HIM UP JMS I (TOUT TAD (MSGJAM /IT COULD BE JAMMED DCA TEMP1 JMS I (TTYOUT KBRD1, KSF /WAIT FOR A CHARACTER OR READER JMP KBRD3 KBRD2, KRS /GET THE CHAR AND (177 /WITHOUT PARITY TAD (-3 /IS IT ^C? SNA JMP I K7600 /YES - TO MONITOR KCF /IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT. ELSE CLEAR IT TAD (3-32 /IS IT ^Z? SNA CLA JMP CDRCIF /YES - EOF JMP CDRIN6 /GO BACK AND TIME OUT AGAIN KBRD3, RCSE /SELECT A CARD? JMP KBRD1 /NO - TRY KEYBOARD TAD (-50 /RESET COUNT DCA TEMP1 TAD (CDRBUF-1 /AND POINTER DCA XRCDR JMP CDRIN3+2 /YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT CDRJA1, KSF JMP .-1 JMP KBRD2 TIMOUT, 0 TIMOU2, 0 PAGE
KEYTRA, TAD I XRCDR /GET KEYWORD COLUMN DCA KEYWD+1 TAD I XRCDR /DITTO DCA KEYWD+2 /CONVERT KEYWORD BITS TO NUMBER TAD (KEYWD-1 /POINT INDEX REGISTER TO KEYWORD BUFFER DCA XR1 TAD (-4 /SET COUNT OF WORDS DCA TEMP1 DCA KEYVAL /ZERO KEYWORD VALUE WRDLP, TAD (-14 /SET BIT COUNT DCA TEMP2 TAD I XR1 /GET WORD BITLP, ISZ KEYVAL /BUMP BIT VALUE CLL RAL /SHIFT INTO LINK SZL /IS THIS ONE ON? JMP KEYFND /YES - KEYWORD FOUND ISZ TEMP2 /COUNT BITS JMP BITLP ISZ TEMP1 /COUNT WORDS JMP WRDLP JMS I (LNOUT /SEND THE LINE NO. JMP I (TEXTRA /ALL BITS OFF - NO KEYWORD KEYBAD, ERROR OUT JMP KEYBLK TAD I XR1 /GET NEXT WORD KEYFND, SZA CLA /TEST THIS WORD JMP KEYBAD /ERROR - MORE THAN ONE KEYWORD MARKED ISZ TEMP1 /COUNT WORDS JMP KEYFND-1 /AND LOOP /OUTPUT THE KEYWORD TAD KEYVAL /IS IT A BATCH CONTROL LANGUAGE COMMAND? TAD (-14 SMA SZA CLA JMP KEYOUT L7777 /FOUND A BCL CARD DCA BCLSW /GENERATE "$END" BEFORE CLOSING FILE CIF CDF F1 JMP I (BCLTRA /YES - HANDLE THAT SPECIALLY KEYOUT, JMS I (LNOUT /SEND LINE NUMBER TAD KEYADR TAD KEYVAL DCA TEMP1 TAD I TEMP1 /GET ADDRESS OF KEYWORD SNA JMP KEYBAD /IF ZERO - UNUSED KEYWORD DCA TEMP1 /ELSE SAVE IT TAD TEMP1 /IS THIS "INPUT" OR "PRINT TAD (-BPRI2 /BEING FUDGED UNDER BASIC? SNA JMP NOSGN /PRINT - CHECK FOR NUMBER SIGN TAD (BPRI2-BINP2 SZA CLA JMP KEYOU5 /NONE - ALL'S WELL NOSGN, TAD (-40 /SET COUNT DCA TEMP3 NOSGN1, TAD I XRCDR /IS NEXT CHAR BLANK? SZA JMP NOSGN2 /NO - IS IT # ISZ TEMP3 JMP NOSGN1 JMP NOSGN3 /REST IS BLANK NOSGN2, TAD (-NOCHR /IS IT "#"? SZA CLA JMP NOSGN3 /NO TAD TEMP1 /YES - USE "INPUT" OR "PRINT" TAD (-BPRI2 SZA CLA TAD (BINP-BPRI TAD (BPRI DCA TEMP1 NOSGN3, TAD (CDRBUF+7 DCA XRCDR KEYOU5, JMS I (UNPACK /AND OUTPUT KEYWORD KEYBLK, TAD (" /INSERT BLANK AFTER KEYWORD OUT JMP I (TEXTRA PAGE
UNPACK, 0 /OUTPUT PACKED 6-BIT ASCII TEXT TAD I TEMP1 /IS FIRST CHAR = 00? AND (7700 SZA CLA JMP KEYOU1 /NO - NORMAL 6-BIT TRANSLATE TAD (211 /YES - THIS IS TAB RATHER THAN END OUT /OUTPUT IT JMP KEYOU3 /AND GET SECOND CHARACTER KEYOU1, TAD I TEMP1 /GET FIRST CHARACTER CLL RTR RTR RTR JMS KEYOU2 /AND OUTPUT IT KEYOU3, TAD I TEMP1 /GET SECOND CHARACTER JMS KEYOU2 /AND OUTPUT IT ISZ TEMP1 /POINT TO NEXT TWO CHARACTERS JMP KEYOU1 /ETC. KEYOU2, 0 AND (77 /MASK FOR THE LOW ORDER BITS SNA JMP I UNPACK /CHARACTER IS 00 - END OF KEYWORD TAD (-37 /<CR>? SNA TAD (215-337 /THIS WILL BE 215 WHEN WE'RE DONE SPA TAD (100 TAD (237 OUT /OUTPUT THE CHARACTER JMP I KEYOU2 TTYOUT, 0 /USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY TAD (TOUT /SWITCH OUTPUT ROUTINES DCA OUTAD JMS UNPACK TAD (XOUT /RESET OUTPUT ROUTINES DCA OUTAD JMP I TTYOUT /RETURN LNOUT, 0 /OUTPUT THE LINE NUMBER SAVFLD;LNCIF TAD LNCNT /GET NUMBER OF CHARS CMA DCA TEMP1 TAD (CDRBUF /START WITH COLUMN 2 DCA XR2 LNOUT1, ISZ TEMP1;SKP /MORE DIGITS? JMP LNOUT2 /NO TAD I XR2;OUT JMP LNOUT1 LNOUT2, TAD LNCNT /ANY DIGITS? SNA CLA JMP LNCIF TAD (" ;OUT /YES - SUFFIX A BLANK LNCIF, 0 JMP I LNOUT PAGE
/TRANSLATE TEXT TEXTRA, DCA CONFLG /CLEAR CONTINUATION FLAG DCA TEMP1 /CLEAR COUNT OF BLANK CHARACTERS TAD (-40 /32 COLUMNS OF TEXT (DECIMAL) DCA TEMP3 TEXLP1, TAD I XRCDR SNA /BLANK? JMP TEXBLK /YES - COUNT A BLANK TAD (-CONTCH /CONTINUATION CHARACTER? SNA JMP TEXCON /YES - ENOUGH OF THIS CARD TAD (CONTCH CONVRT /TRANSLATE THE CHARACTER JMP TEXLP2 /RUBOUT? - GET THE NEXT CHARACTER DCA TEMP2 /SAVE THE CHARACTER JMS TEXBOU /OUTPUT THE COUNTED BLANKS TAD TEMP2 OUT /OUTPUT THE CHARACTER TEXLP2, ISZ TEMP3 /COUNT COLUMNS JMP TEXLP1 TAD (215 /OUTPUT A <CR> OUT JMP TEXFIN TEXCON, JMS TEXBOU CLA CMA DCA CONFLG /SET THE CONTINUATION FLAG JMP TEXFIN TEXBLK, ISZ TEMP1 /COUNT THE BLANKS JMP TEXLP2 /GET THE NEXT CHARACTER TEXBOU, 0 /OUTPUT BLANKS TAD TEMP1 CMA DCA TEMP1 TEXBO1, ISZ TEMP1 /MORE BLANKS SKP JMP I TEXBOU /NO - RETURN TAD (" /YES - OUTPUT A BLANK OUT JMP TEXBO1 TEXFIN, TAD ERRFLG /DID THIS CARD HAVE AN ERROR? SZA CLA ISZ ERRCNT /YES - COUNT IT JMP I (READY /PROCESS NEXT CARD
/CARD CODE TO ASCII CONVERSION ROUTINE XCONVR, 0 /INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII SAVFLD;XCOCIF /SAVE DATA FIELD FOR RETURN DCA CONVR1 /SAVE 12 BIT CARD CODE TAD (RUBOUT AND CONVR1 TAD (-RUBOUT SNA CLA /WAS CHARACTER RUBBED OUT? JMP XCOCIF /YES - RETURN 0 IN AC ISZ XCONVR /NOT RUBBED OUT - SKIP RETURN TAD CONVR1 RTL RTL AND (7 /GET ZONE BITS CLL RAL DCA CONVR2 /2*ZONE BITS TAD CONVR2 RTL TAD CONVR2 /10*ZONE BITS DCA CONVR2 TAD CONVR1 RTL RAL AND (7770 /1-9 "PUNCHES" SNA JMP CONVR3 /IF ALL OFF DON'T INCREMENT COUNT CLL RAL /SHIFT NEXT BIT INTO LINK ISZ CONVR2 /COUNT THE BIT SNL JMP .-3 /LOOP IF OFF SZA CLA JMP CONILL /IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER CONVR3, TAD CONVR2 /GET DISPLACEMENT OF CHAR IN TABLE CLL RAR /GET WORD DISPLACEMENT IN AC TAD (TRTAB /ADDRESS OF WORD DCA CONVR2 TAD I CONVR2 /GET WORD SZL JMP .+4 /IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD RTR RTR RTR AND (77 /MASK FOR LOW PART OF WORD SNA JMP CONVR4 /ZERO IN TABLE IS ILLEGAL CODE (MAYBE) TAD (240 JMP XCOCIF /RETURN WITH 8 BIT ASCII IN AC CONVR4, TAD CONVR1 /GET 12-BIT CARD CODE TAD (-TABCHR /IS IT A TAB CHAR? SNA JMP CONVR5 /YUP! TAD (TABCHR-FFCHR /HOW ABOUT A FORM FEED? SZA CLA JMP CONILL /NOPE - IT'S REALLY BAD TAD (214-211 /IT'S FORM FEED CONVR5, TAD (211 /IT'S TAB JMP XCOCIF CONILL, ERROR /SET ERROR FLAG; RETURN "?" IN AC XCOCIF, 0 JMP I XCONVR CONVR1, 0 CONVR2, 0 PAGE
/OUTPUT A CHARACTER. RETURNS .+1 IF CHARACTER IS /JUST STORED IN BUFFER. RETURNS .+2 IF NO MORE SPACE IN /EMPTY. RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE /MORE BLOCKS IN THE EMPTY. XOUTP, 0 /OUTPUT ROUTINE ISZ OPTSW /THREE WAY SWITCH JMP XOUT1 DCA XOUT2 /SAVE CHAR IN TEMP L7777 TAD XROPT /BACK UP 2 WORDS DCA XOUT3 TAD XOUT2 /GET FIRST HALF OF CHARACTER RTL RTL AND K7400 TAD I XOUT3 /ADD IN FIRST CHARACTER DCA I XOUT3 ISZ XOUT3 TAD XOUT2 /GET SECOND HALF OF CHARACTER RTR RTR RAR AND K7400 TAD I XOUT3 /ADD IN SECOND CHARACTER DCA I XOUT3 ISZ OPTCNT /IS BUFFER FULL? JMP XOUT6 /NO - RETURN NORMALLY JMS I DEVENT /CALL DEVICE HANDLER 4200 /TWO PAGES OF OUTPUT FROM FIELD 0 OPTBUF /BUFFER ADDRESS OPTBLK, 0 /BLOCK NUMBER JMP OPTER4 /ERROR DOING OUTPUT ISZ OPTBLK /INCREMENT BLOCK NUMBER TAD (OPTBUF-1 /RESET BUFFER POINTER DCA XROPT TAD (-200 /AND BUFFER LENGTH /2 DCA OPTCNT ISZ XOUTP /SKIP RETURN IF BLOCK WRITTEN ISZ I (FILLEN /MORE BLOCKS IN EMPTY? ISZ XOUTP /YES - SKIP AGAIN XOUT6, L7775 /RESET 3-WAY SWITCH DCA OPTSW JMP I XOUTP /RETURN XOUT1, DCA I XROPT /SAVE CHARACTER IN BUFFER JMP I XOUTP XOUT2, 0 XOUT3, 0 XOUT, 0 DCA CLOSLN /SAVE CHAR IN A CONVENIENT TEMP TAD CLOSLN JMS XOUTP /OUTPUT THE CHARACTER SKP JMP OPTER5 /FILLED UP AVAILABLE SPACE BEFORE ^Z TAD CLOSLN /WAS IT <CR>? TAD (-215 SZA CLA JMP I XOUT /RETURN TAD (212 JMP XOUT+1 EOF, DCA KEYVAL /FINISH UP ANY BCL CARD IN PROGRESS DCA CONFLG /ZERO THESE TO GET US AROUND DCA LNCNT /THE TESTS IN BCLHUH CIF CDF F1 JMP I (BCLTRA EOF2, ISZ BCLSW /WERE THERE ANY BCL CARDS? JMP EOF1 /NO TAD (MEND /YES - SEND "$END" DCA TEMP1 JMS I (UNPACK EOF1, TAD (32 /^Z JMS XOUTP /OUTPUT CHAR JMP .-1 /BLOCK NOT YET FULL K7400, 7400 /BLOCK WRITTEN TAD I (BLOKNO /BLOCK WRITTEN CIA TAD OPTBLK /GET LENGTH OF FILE WRITTEN DCA CLOSLN /SET LENGTH FOR CLOSE ISZ USRFLG;SKP /IS USR IN CORE? JMP EOF3 /YES CIF 10;JMS I (7700;USRIN /BRING IN THE USR EOF3, L7777 /SET USR IN CORE FLAG DCA USRFLG TAD OFILE /GET DEVICE NUMBER CIF 10;USR;CLOSE CLOSNM, 0 /POINTER TO NAME CLOSLN, 0 /LENGTH OF FILE JMP OPTER6 TAD CLOSLN CIA RTL RTL AND (7760 /GET MINUS LENGTH IN BITS 0-7 CDF 10 TAD I (7617 DCA I (7617 /SET LENGTH AND DEVICE NO. FOR BATCH CDF JMP I (ERRDEC /CONVERT NUMBER OF ERRORS TO DECIMAL PAGE
/CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE ERRDEC, TAD (DECN-1 /START POWERS OF 10 AT 1000 DCA XR1 TAD (-4 DCA TEMP1 /FOUR POWERS OF 10 DCA TEMP5 /CLEAR LEADING ZEROES FLAG TAD ERRCNT /SET VALUE DCA TEMP4 TAD (TOUT /FUDGE OUTPUT CALL DCA OUTAD JMS CONDEC /CONVERT TO DECIMAL TAD (XOUT /RESTORE OUTPUT CALL DCA OUTAD TAD (NOMES /SET UP TO PRINT "NO" DCA TEMP1 TAD TEMP5 /DID WE PRINT A NUMBER? SNA CLA JMS I (TTYOUT /NO - PRINT "NO" TAD (CDMES /PRINT "CARDS IN ERROR" DCA TEMP1 JMS I (TTYOUT EOFJMP, JMP I (CD /DONE WITH THIS ONE - CALL COMMAND DECODER SYSNO /LOAD SYS: NUMBER FOR LOOKUP CIF 10;USR;LOOKUP BATBLK, BATNAM 0 JMP IOER8 TAD BATBLK DCA CHNBLK L0001 DCA I (JSBITS /KEEP USR ACROSS CHAIN CIF 10;USR;CHAIN /NOW CHAIN TO BATCH CHNBLK, 0 CONDEC, 0 /CONVERT A NUMBER TO DECIMAL SAVFLD;CONCIF /SAVE DATA FIELD FOR RETURN DIGLP, TAD I XR1 /GET THIS POWER OF 10 DCA TEMP2 /AND SAVE IT DCA TEMP3 /CLEAR THIS DIGIT DIGLP1, TAD TEMP4 /GET NUMBER TO BE CONVERTED TAD TEMP2 /DIVIDE BY SUBTRACTING SPA JMP DIGLP2 /WENT NEGATIVE - DONE ISZ TEMP3 /BUMP COUNT DCA TEMP4 /SAVE REDUCED VALUE JMP DIGLP1 DIGLP2, CLA TAD TEMP3 /GET VALUE OF THIS DIGIT SZA JMP DIGOUT /NOT A ZERO - PRINT IT TAD TEMP5 /IF ZERO - IS IT LEADING? SNA CLA JMP DIGLPE /YES - DON'T PRINT IT DIGOUT, ISZ TEMP5 /IF PRINTING, THEN ZEROES ARE NOT LEADING TAD (260 /CONVERT TO ASCII OUT DIGLPE, ISZ TEMP1 /LAST DIGIT? JMP DIGLP /NO - LOOP CONCIF, 0 JMP I CONDEC /RETURN TOUT, 0 /SEND A CHARACTER TO THE TTY TLS TSF JMP .-1 TAD (-215 /WAS THE CHARACTER <CR>? SZA CLA JMP I TOUT /NO - RETURN TAD (212 /YES - TYPE A LINE FEED JMP TOUT+1 IOERR1, CDF F0 CLA /TYPE ERROR MESSAGE TAD IOERR /GET NUMBER CLL RAL TAD (IOETAB-1 DCA XR1 TAD I XR1 /GET ADDRESS OF MESSAGE DCA TEMP1 DCA IOERR /CLEAR ERROR NUMBER JMS I (TTYOUT /PRINT IT TAD I XR1 /GO TO RESTART ADDRESS DCA TEMP1 JMP I TEMP1 PAGE
OPTDEV, ZBLOCK 400 /TWO PAGES FOR DEVICE HANDLER OPTBUF, ZBLOCK 400 /TWO PAGES FOR OUTPUT BUFFER CDRBUF, DECIMAL;ZBLOCK 40;OCTAL BATNAM, TEXT "BATCH@SV";*.-1 MEND, TEXT "_$END_" NOMES, TEXT "NO" CDMES, TEXT " CARDS IN ERROR_" MSGJAM, TEXT "LOAD MORE CARDS OR TYPE ^Z_" IOEM1, TEXT "NO OUTPUT FILE SPECIFIED_" IOEM2, TEXT "CAN'T FETCH DEVICE HANDLER_" IOEM3, TEXT "CAN'T ENTER FILE_" IOEM4, TEXT "OUTPUT ERROR_" IOEM5, TEXT "FILE TOO BIG_" IOEM6, TEXT "CAN'T CLOSE FILE_" IOEM7, TEXT "CARD IN READER BACKWARDS. TYPE SPACE TO CONTINUE._" IOEM8, TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/ VERM9, TEXT "MSBAT - VERSION 1_@@@@@@" IOETAB, IOEM1;START IOEM2;START IOEM3;START IOEM4;START IOEM5;START IOEM6;START IOEM7;CDRJA1 IOEM8;7600 VERM9;START DECIMAL DECN, -1000 -100 -10 -1 OCTAL /CHARACTER CODE TRANSLATION TABLE TRTAB, /0 IN ROWS 12-0 0021 /?1 2223 /23 2425 /45 2627 /67 3031 /89 /1 2043 /0C 4651 /FI 5457 /LO 6265 /RU 7004 /X$ /2 1442 /,B 4550 /EH 5356 /KN 6164 /QT 6772 /WZ /3 3632 />: 0106 /!& 7540 /]@ 0000 /<FORM FEED> ? 0000 /?? /4 1641 /.A 4447 /DG 5255 /JM 6063 /PS 6671 /VY /5 3400 /<? 0000 /?? 0000 /?? 0000 /?? 0000 /?? /6 3303 /;# 0705 /'% 7337 /[? THE REAL ? 0077 /<TAB> _ 0000 /?? /7 7435 /\= 1315 /+- 1217 /*/ 7610 /^( 1102 /)"
/BASIC KEYWORDS BDAT, TEXT "DATA" BCAL, TEXT "CALL" BCLO, TEXT "CLOSE" BDEF, TEXT "DEFINE" BCHN, TEXT "CHAIN" BDIM, TEXT "DIMENSION" BCHG, TEXT "CHANGE" BEND, TEXT "END" BEND2, TEXT "CLOSE #4\END" BFIL, TEXT "FILE" BGOS, TEXT "GOSUB" BIF, TEXT "IF" BINP, TEXT "INPUT" BINP2, TEXT "INPUT #3:" BLIS, TEXT "LIST" BNEX, TEXT "NEXT" BOLD, TEXT "OLD" BPRI, TEXT "PRINT" BPRI2, TEXT "PRINT #4:" BREA, TEXT "READ" BRES, TEXT "RESTORE" BRUN, TEXT "RUN" BFOR, TEXT "FOR" BGOT, TEXT "GOTO" BIFE, TEXT "IF END" BLET, TEXT "LET" BLIN, TEXT "LINPUT" BNEW, TEXT "NEW" BON, TEXT "ON" BRND, TEXT "RANDOM" BOV, TEXT "OVERLAY" BREP, TEXT "REPLACE" BUNS, TEXT "UNSAVE" BREM, TEXT "REMARK" BRET, TEXT "RETURN" BSAV, TEXT "SAVE" BSTO, TEXT "STOP" BSTO2, TEXT "CLOSE #4\STOP" /FORTRAN KEYWORDS FCMN, TEXT "@COMMON" FASN, TEXT "@ASSIGN" FCPX, TEXT "@COMPLEX" FBKS, TEXT "@BACKSPACE" FCNT, TEXT "@CONTINUE" FBKD, TEXT "@BLOCK DATA" FDTA, TEXT "@DATA" FCAL, TEXT "@CALL" FDEF, TEXT "@DEFINE FILE" FDO, TEXT "@DO" FEND, TEXT "@END" FEQU, TEXT "@EQUIVALENCE" FFOR, TEXT "@FORMAT" FGOT, TEXT "@GO TO" FINT, TEXT "@INTEGER" FPAU, TEXT "@PAUSE" FREAL, TEXT "@REAL" FREW, TEXT "@REWIND" FSBR, TEXT "@SUBROUTINE" FCMT, TEXT "C" /COMMENT FDIM, TEXT "@DIMENSION" FDBP, TEXT "@DOUBLE PRECISION" FEF, TEXT "@END FILE" FEXT, TEXT "@EXTERNAL" FFUN, TEXT "@FUNCTION" FIF, TEXT "@IF" FLOG, TEXT "@LOGICAL" FREAD, TEXT "@READ" FRET, TEXT "@RETURN" FSTO, TEXT "@STOP" FWRI, TEXT "@WRITE"
BASKEY, /COLUMN 7 ROW BDEF /12 BIFE /11 BLET /0 BLIS /1 BNEW /2 BON /3 BOV /4 BRND /5 BREM /6 BRES /7 BRUN /8 BSTKEY, BSTO /9 /COLUMN 8 ROW BDIM /12 BINKEY, BINP /11 BLIN /0 BNEX /1 BOLD /2 BFIL /3 BPRKEY, BPRI /4 BREA /5 BREP /6 BRET /7 BSAV /8 BUNS /9 /COLUMNS 2-6 COLUMN ROW BCAL /2 12 BENKEY, BEND /2 11 BCLO /3 12 BFOR /3 11 BCHN /4 12 BGOS /4 11 BCHG /5 12 BGOT /5 11 BDAT /6 12 BIF /6 11 FORKEY, /COLUMN 7 /ROW FCAL /12 FDEF /11 FDO /0 FEND /1 FEQU /2 FFOR /3 FGOT /4 FINT /5 FPAU /6 FREAL /7 FREW /8 FSBR /9 /COLUMN 8 ROW FCMT /12 FDIM /11 FDBP /0 FEF /1 FEXT /2 FFUN /3 FIF /4 FLOG /5 FREAD /6 FRET /7 FSTO /8 FWRI /9 /COLUMN 2-6 COLUMN ROW 0 /2 12 0 /2 11 0 /3 12 FCMN /3 11 FASN /4 12 FCPX /4 11 FBKS /5 12 FCNT /5 11 FBKD /6 12 FDTA /6 11
FIELD 1 *17 OXR1, 0 OTEMP1, 0 CHAR, 0 PUTPNT, 0 GETPNT, 0 DATFTN, 0 /ADDRESS OF FORTRAN $RUN GETCHR=JMS I .;XGETCH PUTCHR=JMS I .;XPUTCH BCLIN=JMS I .;XBCLIN OPTION=JMS I .;XOPTIO MOV6=JMS I .;XMOV6 COLNAM=JMS I .;XCOLNA OUTNAM=JMS I .;XOUTNA ISIT=JMS I .;XISIT SEND=JMS I .;XSEND TSTCR=JMS I .;XTSTCR CDRTRA=JMS I .;BCLTRA+1 ISNUM=JMS I .;XISNUM OUT1=JMS I .;OOUT1
*200 /PUT A CHARACTER INTO A 6-BIT BUFFER PUTCH1=XGETCH PUTCH4=CON628 XPUTCH, 0 TAD (-215 /IF <CR>, IT BECOMES 37 SZA TAD (215-337 TAD (337 AND (77 /AND OFF 6 BITS DCA PUTCH1 /SAVE IT IN A TEMP TAD PUTPNT /GET POINTER TO CHARACTER IN 6-BIT BUFFER ISZ PUTPNT /AND BUMP POINTER CLL RAR /GET WORD DISPLACEMENT TAD I XPUTCH /ADD IN BASE ADDRESS ISZ XPUTCH /BUMP RETURN ADDRESS DCA PUTCH4 /SAVE ADDRESS OF WORD CONTAINING CHAR SZL /LINK HAS FIRST OR LAST HALF INDICATOR JMP PUTCH2 TAD PUTCH1 /FIRST HALF - ROTATE CHAR INTO HIGH BITS CLL RTL;RTL;RTL DCA PUTCH1 TAD I PUTCH4 /GET ANY CHARACTER ALREADY THERE AND (77 JMP PUTCH3 PUTCH2, TAD I PUTCH4 AND (7700 /GET CHARACTER ALREADY THERE PUTCH3, TAD PUTCH1 /ADD IN NEW CHARACTER DCA I PUTCH4 /STORE THEM BOTH JMP I XPUTCH /AND RETURN /GET A CHARACTER FROM A 6-BIT BUFFER XGETCH, 0 TAD XGETCH /MOVE RETURN ADDRESS TO CON628 DCA CON628 TAD GETPNT /GET POINTER TO CHARACTER ISZ GETPNT /BUMP IT FOR NEXT TIME JMP CON628+1 /ENTER CONVERSION ROUTINE /CONVERT 6-BIT ASCII TO 8-BIT /AC HAS POINTER TO CHARACTER /ARGUMENT IS BASE ADDRESS OF BUFFER CO628X=XGETCH CON628, 0 CLL RAR /GET WORD DISPLACEMENT IN AC TAD I CON628 /ADD BASE ADDRESS OF BUFFER ISZ CON628 /BUMP RETURN ADDRESS DCA CO628X /SAVE ADDRESS TAD I CO628X /GET WORD CONTAINING CHARACTER SZL /LINK HAS INDICATOR FOR FIRST OR LAST CHAR JMP .+4 RTR;RTR;RTR /FIRST CHAR - PUT IN LOW BITS AND (77 JMS XSEND3 /GET PROPER 8-BIT REPRESENTATION DCA CHAR /SAVE IT TAD CHAR /RETURN WITH IT IN AC JMP I CON628 /RETURN XSEND3, 0 TAD (-37 SNA TAD (215-337 SPA TAD (100 TAD (237 JMP I XSEND3 GETCDR, 0 CIF CDF F0 JMS I (GETCD1 /GET A CHAR FROM THE CDR BUFFER JMP I GETCDR OOUT1, 0 CIF CDF F0 JMS I (OOUT2 JMP I OOUT1 MOVODV, 0 DCA .+2 MOV6;0;BATOUT CIF F0 /RETURN DF=1 JMP I MOVODV XTSTCR, 0 GETCHR;BCLBUF TAD (-215 SNA CLA ISZ XTSTCR L7777 TAD GETPNT DCA GETPNT JMP I XTSTCR PAGE
/SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE /BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL. AN OPTION IS /RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/". IT'S NAME /IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," , /"=",OR <CR>. THE NAME IS TERMINATED BY ANY ONE OF THE /PREVIOUS DELIMITERS. IF IT IS TERMINATED BY A "=" AND /THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME, /THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A /"/" , "," , OR <CR>. THE SUBROUTINE CALL IS FOLLOWED BY A /POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY /A ZERO ENTRY. EACH ENTRY POINTS TO AN OPTION CONTROL /BLOCK IN THE FOLLOWING FORM: / OPTION CONTROL WORD / (FILE NAME SPACE IF NEEDED - 6 WORDS) / TEXT "OPTION NAME" / /THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS: / BIT 0: ON RETURN THIS BIT WILL BE SET IF / THE OPTION WAS FOUND, AND CLEARED / IF NOT / BIT1: ON RETURN THIS BIT IS SET IF A NAME / WAS GIVEN WITH THE OPTION / BIT 2: SET IF OPTION HAS ALLOCATED 6 WORDS / FOR A POSSIBLE FILE NAME. CLEARED / IF NOT / BITS 6-8: NUMBER OF CHARACTERS -1 OF SHORT / FORM OF OPTION / BITS 9-11: DIFFERENCE BETWEEN SIZES OF / SHORT AND LONG FORMS / THE SUM OF BITS 6-8 AND BITS 9-11 / SHOULD TOTAL THE LENGTH OF THE / LONG FORM-1 / /THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT /DEVICE, NAME, AND EXTENSION. / XOPTIO, 0 /TURN OFF ALL OPTIONS TAD I XOPTIO /GET ADDRESS OF LIST OF OPTION ADDRESSES DCA OPTLIS /SAVE IT OPTIO1, TAD I OPTLIS /GET OPTION ADDRESS ISZ OPTLIS /POINT TO NEXT ONE SNA JMP OPTIO2 /DONE TURNING OFF ALL OPTIONS DCA OPTCTL TAD I OPTCTL /GET OPTION CONTROL WORD AND (1777 /CLEAR FIRST BIT DCA I OPTCTL JMP OPTIO1 /LOOP /SEARCH BCL BUFFER FOR "/" OPTIO2, DCA GETPNT /START AT BEGINNING OF BATCH CONTROL LINE OPTIO3, GETCHR;BCLBUF /GET A CHARACTER FROM THE BUFFER ISIT /IS IT "/" OR <CR>? OPTIS3;OPTIS4-1 JMP OPTIO3 /NO - KEEP LOOKING OPTI3A, TAD GETPNT /YES - SAVE IT'S POSITION DCA OPTBEG TAD I XOPTIO /GET ADDRESS OF LIST AGAIN DCA OPTLIS /AND SAVE IT /FOUND A "/" - TRY ALL OPTIONS OPTIO4, TAD OPTBEG /START COMPARISON OF OPTION WITH CHARACTER AFTER "/" DCA GETPNT TAD I OPTLIS /GET ADDRESS OF OPTION CONTROL WORD ISZ OPTLIS /AND BUMP POINTER FOR NEXT TIME SNA /IS THE LIST ENDED? JMP I (OPTIER /YES - OPTION WAS INVALID DCA OPTCTL /NO - SAVE ADDRESS OF CONTROL WORD TAD I OPTCTL /GET CONTROL WORD RTL SPA CLA /DOES IT HAVE SPACE FOR A FILE NAME TAD (6 /YES - ADD SIZE OF THE SPACE TAD OPTCTL /ADD ADDRESS OF OPTION IAC /BUMP ONE FOR CONTROL WORD DCA OPTTEX /SAVE ADDRESS OF OPTION TEXT TAD I OPTCTL /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD RAR;RTR AND (7 CMA /NEGATE IT (INCREMENTED BY ONE) DCA OPTCT1 /SAVE IN COUNTER DCA OPTCT2 /ZERO CHARACTER POSITION
/COMPARE OPTION WITH CONTENTS OF BCL BUFFER OPTIO5, JMS OPTI6A SZA CLA /ARE THEY THE SAME? JMP OPTIO4 /NO - TRY NEXT OPTION ISZ OPTCT1 /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE? JMP OPTIO5 /NO - KEEP COMPARING TAD GETPNT /SAVE CURRENT BUFFER POSITION DCA OPTTM2 TAD I OPTCTL /GET REMAINING LENGTH FROM CONTROL WORD AND (7 CMA DCA OPTCT1 OPTIO6, ISZ OPTCT1 /DONE WITH REMAINING CHARACTERS? SKP JMP OPTIO7 /YES - SUCCESS JMS OPTI6A SNA CLA /ARE THEY THE SAME? JMP OPTIO6 /YES - KEEP GOING TAD OPTTM2 /NO - MOVE POINTER BACK TO SHORT FORM DCA GETPNT JMP OPTIO7 OPTI6A, 0 TAD OPTCT2 ISZ OPTCT2 JMS I (CON628 OPTTEX, 0 CIA DCA OPTTM1 GETCHR;BCLBUF TAD OPTTM1 JMP I OPTI6A OPTRET, ISZ XOPTIO /INCREMENT RETURN ADDRESS DCA GETPNT /SET POINTER TO BEGINNING OF BUFFER JMP I XOPTIO OPTLIS, 0 OPTCTL, 0 OPTBEG, 0 OPTCT1, 0 OPTCT2, 0 OPTTM1, 0 OPTTM2, 0
/TEST DELIMITER AFTER OPTION OPTIO7, GETCHR;BCLBUF /GET NEXT BUFFER CHARACTER ISIT /IS IT "=", "," ,"/", OR <CR>? OPTIS1;OPTIS2-1 JMP I (OPTIER /NONE OF THESE OPTIO8, TAD I OPTCTL /YES - GET CONTROL WORD RTL SMA CLA /DOES IT TAKE A FILE NAME? JMP I (OPTIER /NO - ERROR TAD OPTCTL /GET ADDRESS OF FILE NAME SPACE IAC DCA .+2 COLNAM /AND COLLECT A NAME INTO IT OPTTM3, 0 JMP I (OPTIER /ERROR RETURN TAD I OPTCTL /TURN ON NAME BIT AND (1777 TAD (2000 DCA I OPTCTL OPTIO9, TAD I OPTCTL /GET CONTROL WORD AND (3777 TAD (4000 /TURN ON OPTION FOUND BIT DCA I OPTCTL JMP I (OPTI10 PAGE
/ON ERROR, REPORT IT OPTIER, TAD I (OPTBEG /OPTION BEGINS AT THIS POSITION JMS OUTERR /OUTPUT THE ERROR OPTERM /SQUISH THE CURRENT OPTION OUT OF BCL BUFFER OPTI10, L7777 /BACK UP OVER "/" TAD I (OPTBEG /POINT TO BEGINNING OF OPTION JMS BCLSQU /SQUISH OUT THIS OPTION L7777 TAD I (OPTBEG JMP I (OPTIO2 /GO LOOK FOR MORE OPTIONS
/SQUISH OUT A PORTION OF THE BCL BUFFER / TAD X /POSITION OF FIRST CHAR OF SQUISH / JMS BCLSQU /GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER /SQUISH CHARS. ONE CHAR PRECEDING IT IS TESTED, /AND IS KEPT IF IT IS A "/" OR <CR> BCLSQU, 0 DCA PUTPNT /AC POINTS TO BEGINNING OF AREA TO BE SQUISHED TAD PUTPNT /SAVE THE POINTER DCA OUTERR L7777 TAD GETPNT DCA GETPNT /TEST LAST CHAR OF STUFF TO BE SQUISHED GETCHR;BCLBUF ISIT /IS IT "/", OR <CR>? BCLIS1;BCLIS2-1 BCLSQ1, GETCHR;BCLBUF /GET A CHAR TAD (-215 /IS IT <CR>? SNA CLA JMP BCLSQ3 /YES - DONE BCLSQ2, TAD CHAR /RESTORE CHAR PUTCHR;BCLBUF /PUT THE CHAR IN THE BUFFER JMP BCLSQ1 /GET ANOTHER CHAR BCLSQ3, TAD (215 /PUT A <CR> PUTCHR;BCLBUF TAD OUTERR /RESTORE POINTER DCA GETPNT JMP I BCLSQU /RETURN /SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER /TO THE OUTPUT BUFFER / TAD X /POSITION OF FIRST CHAR IN BUFFER TO BE SENT / JMS OUTERR / A /ADDRESS OF ERROR MESSAGE TO PRECEDE IT / /SIX-BIT ASCII OUTERR, 0 DCA GETPNT /SET BEGINNING OF BCL LINE TO OUTPUT TAD I OUTERR /GET ERROR MESSAGE ADDRESS ISZ OUTERR SEND /PRINT IT OUTER1, GETCHR;BCLBUF /GET A CHARACTER ISIT /IS IT "," ,"/", OR <CR>? OUTIS1;OUTIS2-1 TAD CHAR /NO - SEND CHAR OUT1 JMP OUTER1 OUTER2, TAD (215 OUT1 JMP I OUTERR /RETURN /TEST A CHAR AND JUMP IF IN LIST / JMS XISIT / A1 /ADDRESS OF LIST OF NEGATIVE OF CHARS / /TERMINATED BY A POSITIVE OR ZERO / A2-1 /ADDRESS -1 OF LIST OF / /TRANSFER ADDRESSES XISIT, 0 DCA ISIT1 /SAVE CHAR TAD I XISIT /GET LIST OF CHARS ISZ XISIT DCA ISIT2 TAD I XISIT /GET LIST OF ADDRS - 1 ISZ XISIT DCA ISIT3 ISIT4, TAD I ISIT2 /GET THE NEXT CHAR ISZ ISIT2 ISZ ISIT3 SMA JMP ISIT5 /END OF LIST SIGNALLED BY ENTRY>=0 TAD ISIT1 /IS IT THE CHAR? SZA CLA JMP ISIT4 /NO - TRY THE NEXT TAD I ISIT3 /GET SEND ADDRESS DCA XISIT ISIT5, CLA JMP I XISIT ISIT1, 0 ISIT2, 0 ISIT3, 0 PAGE
/COLLECT A NAME FROM THE BUFFER / JMS XCOLNA / X /ADDRESS OF SPACE TO RECEIVE NAME / JMP ERR /INVALID NAME XCOLNA, 0 TAD I XCOLNA DCA .+3 MOV6;ZER6;0 TAD I XCOLNA /ARGUMENT IS ADDRESS TO PUT NAME ISZ XCOLNA DCA COLPU1+2 /SAVE IT FOR USE AS PUTCHR ARG L7776 /SET NAME - EXTENSION SWITCH FOR NAME DCA COLSW TAD (COLIS1 /SET TO COLLECT ANYTHING DCA COLIS3 /I.E. DEVICE, FILE, OR EXTENSION TAD (COLIS2-1 DCA COLIS3+1 TAD GETPNT /SAVE POINTER TO BEGINNING OF NAME DCA COLNP1 COLGE1, TAD GETPNT /SAVE POINTER TO BEGINNING OF SECTION DCA COLNP2 /OF NAME COLGE2, GETCHR;BCLBUF /GET A CHAR ISIT /IS IT ":",".","/", "," , OR <CR>? COLIS3, 0;0 JMP COLGE2 COLDEV, JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0 ISZ COLIS3 /REMOVE ":" FROM LIST ISZ COLIS3+1 JMP COLGE1 /COLLECT NEXT PART OF NAME COLFIL, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 ISZ COLSW /NEXT TIME COLLECT EXTENSION TAD (COLIS1+2 /REMOVE "." FROM LIST DCA COLIS3 TAD (COLIS2+1 DCA COLIS3+1 JMP COLGE1 /COLLECT NEXT PART OF NAME COLEXT, ISZ COLSW /ARE WE COLLECTING NAME OR EXTENSION? JMP COLEX1 /NAME JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12 JMP COLEX2 COLEX1, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 COLEX2, ISZ XCOLNA /NO ERRORS JMP COLEX3 COLERR, CLA TAD COLNP1 /POINT TO BEGINNING OF NAME JMS I (OUTERR /SEND IT AS ERROR MESSAGE COLERM COLEX3, TAD COLNP1 /POINT TO BEGINNING OF NAME JMS I (BCLSQU /SQUISH IT OUT JMP I XCOLNA /RETURN COLMOV, 0 TAD I COLMOV /FIRST ARG IS POSITION ISZ COLMOV DCA PUTPNT TAD I COLMOV /SECOND ARG IS COUNT ISZ COLMOV DCA COLCT1 TAD CHAR /GET DELIMITER CIA DCA COLCH1 /SAVE FOR TEST TAD CHAR TAD (-"Z DCA COLCH2 /ANOTHER TEST TAD COLNP2 /POINT TO BEGINNING OF THIS PART DCA GETPNT COLMV1, GETCHR;BCLBUF /GET NEXT CHAR TAD COLCH1 /SUBTRACT THE DELIMITER SNA JMP I COLMOV /DELIMITER - WE'RE DONE TAD COLCH2 /CHAR-"Z" SMA SZA JMP COLERR /NOT ALPHA-NUMERIC TAD ("Z-"A SMA JMP COLPUT /ALPHABETIC TAD ("A-"9 SMA SZA JMP COLERR /NOT NUMERIC TAD ("9-"0 SPA JMP COLERR /NOT NUMERIC COLPUT, CLA ISZ COLCT1 /HAVE WE USED UP OUR COUNT? JMP COLPU1 /NO - PUT THE CHAR L7777 /YES - SET COUNTER TO SKIP DCA COLCT1 JMP COLMV1 /GET NEXT CHAR COLPU1, TAD CHAR PUTCHR;0 /PUT THE CHAR IN THE USER SPACE JMP COLMV1 /GET THE NEXT CHAR COLSW, 0 /FILE NAME OR EXTENSION SWITCH COLNP1, 0 /POINTER TO BEGINNING OF NAME COLNP2, 0 /POINTER TO BEGINNING OF NAME PART COLCH1, 0 /TEMP LOC FOR COLMOV COLCH2, 0 /DITTO COLCT1, 0 /DITTO PAGE
XMOV6, 0 TAD I XMOV6 /GET "FROM" ADDRESS ISZ XMOV6 DCA MOV61 TAD I XMOV6 /GET "TO" ADDRESS ISZ XMOV6 DCA MOV62 TAD (-6 DCA MOV63 MOV64, TAD I MOV61 DCA I MOV62 ISZ MOV61 ISZ MOV62 ISZ MOV63 JMP MOV64 JMP I XMOV6 /RETURN MOV61, 0 MOV62, 0 MOV63, 0 XBCLIN, 0 DCA PUTPNT /START AT BEGINNING OF BCL BUFFER JMS I (SENDKY /SEND THE KEYWORD DCA MOV61 /CLEAR THE BLANK COUNTER BCLIN5, JMS BCLIN3 /GET NEXT CARD AND PUT IT INTO BCL BUFFER JMP BCLIN7+2 /CARD NOT CONTINUED - DONE CIF F0 JMS I (CDRIN /READ ANOTHER CARD JMP BCLIN7+2 /EOF TAD (-10 DCA BCLIN4 BCLIN6, JMS I (GETCDR /GET FIRST 8 CHARS SZA CLA /TEST FOR ZERO JMP BCLIN7 /NON-ZERO - ERROR ISZ BCLIN4 JMP BCLIN6 JMP BCLIN5 /OK - PUT IT IN BUFFER BCLIN7, CDF F0 DCA I (CDRFLG /SET CDRIN TO RETURN THIS CARD AGAIN CDF F1 TAD (215 /PUT A <CR> PUTCHR;BCLBUF TAD (215;OUT1 DCA GETPNT /SET POINTER TO BEGINNING JMP I XBCLIN /RETURN BCLIN4, 0 BCLIN3, 0 TAD (-40 DCA BCLIN4 BCLIN9, JMS I (GETCDR /GET NEXT CDR CHAR SNA JMP BCLI13 /BLANK TAD (-CONTCH SNA JMP BCLI10 /CONTINUATION TAD (CONTCH CIF F0 JMS I (XCONVR JMP BCLIN8 /RUBOUT DCA XMOV6 /SAVE THE CHAR JMS BCLI14 /SEND THE BLANKS TAD XMOV6 OUT1 /SEND IT TAD XMOV6 PUTCHR;BCLBUF /PUT IT TAD PUTPNT TAD (-BCLSIZ^2+2 /BCL BUFFER FULL? SMA CLA JMP BCLI11 /FULL - ERROR BCLIN8, ISZ BCLIN4 /COUNT COLUMNS JMP BCLIN9 /LOOP JMP I BCLIN3 BCLI10, ISZ BCLIN3 /SKIP RETURN FOR CONTINUATION DCA MOV61 /CLEAR THE BLANK COUNTER SEND;BCL10E /"_$" TAD (211;OUT1 /<TAB> JMP I BCLIN3 /RETURN BCLI11, SEND;BCL11E /SEND ERROR BCLI12, CIF F0 JMS I (CDRIN /GET THE NEXT CARD JMP BCLIN7+2 JMS I (GETCDR /GET THE NEXT COLUMN DCA BCLIN4 /SAVE THIS COLUMN TAD (JOBBIT /IS THIS A $JOB CARD? AND BCLIN4 SNA CLA JMP BCLI12 /NO - FLUSH TO $JOB TAD (-JOBBIT-1 AND BCLIN4 SZA CLA JMP BCLI12 JMP BCLIN7 /YES - DONE BCLI13, ISZ MOV61 /ANOTHER BLANK JMP BCLIN8 BCLI14, 0 TAD MOV61 CMA DCA MOV61 BCLI15, ISZ MOV61;SKP JMP I BCLI14 TAD (" ;OUT1 JMP BCLI15 PAGE
BCLTRA, JMP I .+1 /GO FINISH UP LAST BCL COMMAND BCLHUH /HUH? - I.E. WHICH COMMAND WAS IT? CIF CDF F0 JMP I (TEXFIN /TO COPY A DECK UNTIL THE NEXT BCL /COMMAND - JMS BCLTRA+1 BCLHU1, 0 /JMS HERE WITH ARG = TRANSFER ADDRESS TAD I BCLHU1 /GET TRANSFER ADDRESS DCA BCLHU1 TAD (BCLHUH /ON NEXT BCL CARD - NOTHING TO FINISH DCA BCLTRA+1 CIF CDF F0 /FIELD 0! JMP I BCLHU1 /GO GO GO BCLHUH, CDF F0 TAD I (KEYVAL /GET KEYWORD VALUE CDF F1 TAD (BCLGO /USE IT TO GET TRANSFER ADDRESS DCA OTEMP1 TAD I OTEMP1 DCA OTEMP1 CDF F0 TAD I (CONFLG /WAS LAST CARD CONTINUED? CDF F1 SZA CLA JMS BCLHU2 /YES - ERROR CDF F0 TAD I (LNCNT /DID THIS CARD HAVE A LINE NUMBER? CDF F1 SNA CLA JMP I OTEMP1 /YES - GO TO IT! CIF CDF F0 JMS I (LNOUT /OUTPUT THE LINE NUMBER JMS BCLHU2 /WHAT'S IT DOING WITH A NUMBER ANYWAY? JMP I OTEMP1 /NOW WE GO. BCLHU2, 0 CDF F0 ISZ I (ERRFLG CDF F1 SEND;BCLHM1 /"?_" JMP I BCLHU2 BCLEOF, JMS BCLHU1;EOF2 CERR, JMS BCLHU1;KEYBAD
XOUTNA, 0 TAD I XOUTNA /GET ADDRESS OF NAME ISZ XOUTNA DCA OUTNA2 TAD GETPNT /SAVE BUFFER INPUT POINTER DCA OUTNA6 DCA OUTNA3 /SET FLAG FOR NO NAME JMS OUTNA4;0;-4 /SEND 4 CHARS FROM POSITION 0 TAD OUTNA3 SNA CLA JMP .+3 /NO DEVICE - NO ":" TAD (": OUT1 JMS OUTNA4;4;-6 /SEND 6 CHARS FROM POSITION 4 TAD (12 /SET UP TO GET EXTENSION DCA GETPNT JMS OUTNA1 /GET FIRST CHAR JMP OUTNA5 /NO EXTENSION CLA TAD (". OUT1 JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12 OUTNA5, TAD OUTNA6 /RESTORE BUFFER INPUT POINTER DCA GETPNT JMP I XOUTNA OUTNA1, 0 GETCHR OUTNA2, 0 TAD (-300 /IS IT NULL? SNA JMP I OUTNA1 /YES - DONE ISZ OUTNA1 /SKIP RETURN TAD (300 JMP I OUTNA1 OUTNA3, 0 /NAME PRESENT SWITCH OUTNA4, 0 TAD I OUTNA4 /GET CHAR POSITION ISZ OUTNA4 DCA GETPNT TAD I OUTNA4 /GET NO OF CHARS ISZ OUTNA4 DCA OUTN41 OUTN42, JMS OUTNA1 /GET A CHAR JMP I OUTNA4 /NULL - DONE OUT1 ISZ OUTNA3 /SET NAME PRESENT ISZ OUTN41 JMP OUTN42 JMP I OUTNA4 /DONE - RETURN OUTN41, 0 OUTNA6, 0 PAGE
XSEND, 0 SZA /IF AC =0, ADDRESS IS ARG OF CALL JMP XSEND4 TAD I XSEND /GET MESSAGE ADDRESS ISZ XSEND XSEND4, DCA OTEMP1 XSEND1, TAD I OTEMP1 CLL RTR;RTR;RTR JMS XSEND2 TAD I OTEMP1 JMS XSEND2 ISZ OTEMP1 JMP XSEND1 XSEND2, 0 AND (77 SNA JMP I XSEND /NULL ENDS MESSAGE JMS I (XSEND3 /GET 8-BIT REPRESENTATION OUT1 JMP I XSEND2 MAKNAM, 0 TAD (DECN /START CONVERSION AT 100 CDF F0 DCA I (XR1 L7775 /CONVERT 3 DIGITS DCA I (TEMP1 ISZ NAMCNT /BUMP NAME COUNTER TAD NAMCNT DCA I (TEMP4 L0001 DCA I (TEMP5 /SAVE LEADING ZEROES TAD (MAKNA2 DCA I (OUTAD CDF F1 TAD I MAKNAM /MOVE DEFAULT NAME TO OUTPUT AREA DCA .+3 MOV6;FILNAM;0 TAD I MAKNAM ISZ MAKNAM DCA MAKNA3+2 TAD (7 /PUT NUMBER AT POSITION 7-9 DCA PUTPNT CIF F0 JMS I (CONDEC /OUTPUT NUMBER TAD (XOUT /RESTORE OUTPUT ROUTINE CDF F0 DCA I (OUTAD CDF F1 JMP I MAKNAM /RETURN MAKNA3, 0 PUTCHR;0 CIF CDF F0 JMP I MAKNA3 NAMCNT, 0 XISNUM, 0 TAD (-"9 SMA SZA JMP XISNU1 TAD ("9-"0 SMA ISZ XISNUM XISNU1, CLA JMP I XISNUM SAVNAM, 0 TAD SAVPNT DCA SAV1+2 /PUT NAME IN LIST TAD SAVPNT TAD (-SAVTOP /ARE WE AT TOP OF LIST? SNA JMP I SAVNAM /YES - DON'T SAVE NAME TAD (SAVTOP+6 DCA SAVPNT /ADVANCE POINTER FOR NEXT TIME TAD I SAVNAM /GET NAME TO SAVE DCA SAV1+1 ISZ SAVNAM SAV1, MOV6;0;0 JMP I SAVNAM SAVPNT, SAVARA /POINT TO SAVE AREA UNSNAM, 0 TAD I UNSNAM ISZ UNSNAM DCA UNSNA1+2 /POINT TO SPACE TO RECEIVE NAME TAD SAVPNT TAD (-6-SAVARA SPA JMP UNSNA2 /EMPTY - RETURN TAD (SAVARA DCA SAVPNT /BACK UP TAD SAVPNT DCA UNSNA1+1 /SET ADDRESS FROM WHICH NAME WILL COME UNSNA1, MOV6;0;0 ISZ UNSNAM /SKIP RETURN UNLESS EMPTY UNSNA2, CLA JMP I UNSNAM PAGE
/ / / $DECK / / CDECK, BCLIN /GET THE LINE OPTION;CDEOPT /ANALYZE THE OPTIONS TSTCR /END OF LINE? JMP CDECK1 /NO - GET A NAME CDECK3, MOV6;CDEDEF;NAME1 /YES - MOVE DEFAULT NAME JMP CDECK2 CDECK1, COLNAM;NAME1 /COLLECT A NAME JMP CDECK3 /FAIL - BAD NAME CDECK2, SEND;CDEM1 /".R PIP_*" OUTNAM;NAME1 /SEND THE NAME SEND;CDEM2 /"<BAT:_" TAD I (OPFOR /WAS "/FOR" SPECIFIED? SMA CLA TAD (BASKEY-FORKEY /NO - USE BASIC TAD (FORKEY-15 CDF F0 DCA I (KEYADR CDF F1 CDRTRA /TRANSLATE THE CARDS SEND;CMEOD /"$EOD_" TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? SPA CLA JMP I (BCLHUH /YES - DONE TAD ("*;OUT1 JMS I (PIPOUT;BATOUT /SEND NAME OF LISTING DEVICE TAD ("<;OUT1 OUTNAM;NAME1 /SEND NAME OF FILE TAD (215;OUT1 JMP I (BCLHUH
/ / / $BASIC / / CBAS, BCLIN /GET BCL LINE OPTION;CBAOPT /ANALYZE OPTIONS TSTCR /END OF LINE? JMP CBAS2 /NO - GET NAME CBAS1, MOV6;CBATK;NAME1 /MOVE IN BAT: JMP CBAS3 CBAS2, COLNAM;NAME1 /COLLECT THE NAME JMP CBAS1 /FAIL - USE DEFAULT CBAS3, SEND;CBAM1 /".R PIP_*PROG.BA<" OUTNAM;NAME1 /SEND NAME TAD (215;OUT1 CBAS5, JMP CBAS7 /SET OR CLOBBERED IN INIT TAD (211;OUT1 SEND;CBAM3 /'FILE #0,"DATA.DA"\FILEV #1,"' OUTNAM;BATOUT /"TTY:" OR "LPT:" SEND;CBAM4 /'"_' CBAS7, TAD (BASKEY-15 CDF F0 DCA I (KEYADR /SET KEYWORD LIST CDF F1 CDRTRA /TRANSLATE CARDS SEND;CMEOD /"$EOD_" TAD I (OPNOL /WAS "/NOLIST SPECIFIED?" SPA CLA JMP CBAS4 TAD ("*;OUT1 /NO - LIST IT JMS I (PIPOUT;BATOUT SEND;CBAM2 /"<PROG.BA_" CBAS4, TAD (DATBAS DCA I (DATADR /SET "$DATA" ROUTINE JMP I (BCLHUH /DONE / / / $RUN (AFTER $BASIC) / / DATBAS, BCLIN OPTION;ZER6 /NO OPTIONS SEND;DATBM1 /".R PIP_*DATA.DA<BAT:_" CDRTRA /TRANSLATE THE CARDS SEND;DATBM2 /"$EOD_.R BCOMP_*PROG.BA_" TAD DATFTN /$RUN IS FORTRAN NOW DCA I (DATADR JMP I (BCLHUH /DONE PAGE
/ / / $FORTRAN (FORTRAN IV) / / CF4, BCLIN /GET BCL LINE OPTION;CF4OPT /ANALYZE OPTIONS TSTCR /END OF LINE? JMP CF42 CF41, JMS I (MAKNAM;NAME1 /YES - MAKE A NAME JMP CF43 CF42, COLNAM;NAME1 /NO - COLLECT A NAME JMP CF41 /BAD NAME - MAKE ONE CF43, SEND;CF4M1 /".R PIP_*" OUTNAM;NAME1 /SEND THE NAME TAD ("<;OUT1 TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN SMA CLA JMP CF44 /NO OUTNAM;OPSRC+1 /YES - SEND IT TAD (215;OUT1 JMP CF45 CF44, SEND;CF4M2 /"BAT:_" CF45, TAD (FORKEY-15 /FORTRAN CARDS CDF F0 DCA I (KEYADR CDF F1 CDRTRA /TRANSLATE THE CARDS SEND;CF4M3 /"$EOD_.R F4_*" OUTNAM;NAME1 TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? SPA CLA JMP CF46 /YES - DON'T GENERATE LIST FILES TAD (",;OUT1 TAD I (OPLIS RAL SPA CLA /WAS A NAME GIVEN? JMP CF47 /YES - GET IT MOV6;BATOUT;OPLIS+1 /NO - GIVE LIST DEV CF47, OUTNAM;OPLIS+1 /SEND NAME OF LISTING FILE CF46, TAD ("<;OUT1 OUTNAM;NAME1 TAD I (OPRALF /PRODUCE RALF LISTING? SMA CLA JMP CF48 /NO SEND;CF4M4 /"/F" CF48, TAD (215;OUT1 TAD (DATF4 DCA I (DATADR /SET "$DATA" ADDRESS JMS I (SAVNAM;NAME1 /SAVE NAME FOR "$LOAD" JMP I (BCLHUH /DONE / / / $RUN (FORTRAN II) / / DATF2, BCLIN JMS I (CL2S /DO $LOAD STUFF JMP DATL21 DATL2, BCLIN OPTION;ZER6 /NO OPTIONS IF ALREADY LOADED JMP DATL21 DATX2, BCLIN JMS I (DATNAM /GET A NAME TAD I (NAMELD /WAS A DEVICE SPECIFIED? SZA CLA JMP DATL21 /YES TAD (0423 /NO - USE "DSK" DCA I (NAMELD TAD (1300 DCA I (NAMELD+1 DATL21, SEND;DTF2M1 /".RUN " OUTNAM;NAMELD TAD (215;OUT1 CDRTRA /WITH GENIOX, INPUT IS FROM BATCH STREAM SEND;CMEOD /"$EOD_" TAD DATFTN /$DATA IS NOW FORTRAN DCA I (DATADR JMP I (BCLHUH PAGE
/ / / $LOAD (FORTRAN IV) / / /THIS SUBROUTINE IS USED WITH EITHER A $LOAD OR $RUN CL4S, 0 OPTION;CL4OPT /ANALYZE OPTIONS SEND;CL4SM1 /".R LOAD_*" TAD I (OPIMAG /WAS "/IMAGE" FILE SPECIFIED RAL SMA CLA JMP CL4S1 /NO MOV6;OPIMAG+1;NAMELD /YES - MOVE NAME JMP CL4S2 CL4S1, MOV6;CL4DEF;NAMELD /USE DEFAULT NAME CL4S2, OUTNAM;NAMELD /SEND THE NAME OF THE IMAGE FILE TAD I (OPLIS /WAS "/LIST" FILE GIVEN? SMA CLA JMP CL4S4 TAD I (OPLIS;RAL SPA CLA JMP CL4S3 MOV6;BATOUT;OPLIS+1 CL4S3, TAD (",;OUT1 OUTNAM;OPLIS+1 CL4S4, TAD I (OPSSYM /LIST SYSTEM SYMBOLS? SMA CLA JMP CL4S11 /NO SEND;CL4SM8 /"/S" CL4S11, SEND;CL4SM2 /"<_*" TAD I (OPLIB;RAL /WAS "/LIBRARY" FILE SPECIFIED? SMA CLA JMP CL4S5 OUTNAM;OPLIB+1 /SEND NAME OF LIBRARY SEND;CL4SM3 /"/L_*" CL4S5, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED? SPA CLA JMP CL4S7 /YES - DON'T BOTHER WITH SAVED NAMES CL4S6, JMS I (UNSNAM;NAME1 /GET A SAVED NAME JMP CL4S7 /OUT OF NAMES OUTNAM;NAME1 /SEND IT SEND;CL4SM4 /"/C_*" JMP CL4S6 CL4S7, TSTCR;SKP /END OF LINE? JMP CL4S10 GETCHR;BCLBUF /GET NEXT CHARACTER DCA CHRSAV GETCHR;BCLBUF TAD (-"= SZA CLA JMP CL4S8 TAD CHRSAV ISIT;CLIS1;CLIS2-1 /IS IT "L" OR "O" CL4S8, L7776 TAD GETPNT /BACK UP 2 DCA GETPNT CL4S9, COLNAM;NAME1 JMP CL4S7 /BAD NAME OUTNAM;NAME1 /SEND THE NAME SEND;CL4SM4 /"/C_*" JMP CL4S7 CL4SL, SEND;CL4SM5 /"/O" CL4SO, SEND;CL4SM6 /"_*" L7776 TAD GETPNT /BACK 2 JMS I (BCLSQU JMP CL4S9 CL4S10, SEND;CL4SM7 /"$_" DCA I (NAMCNT JMP I CL4S /RETURN /$LOAD CL4, BCLIN /GET THE LINE JMS CL4S /ANALYZE IT TAD (DATL4 /SET "$DATA" ADDRESS DCA I (DATADR JMS I (BCLHU1;TEXFIN CHRSAV, 0 PAGE
/ / / $RUN (FORTRAN IV) - FORMERLY CALLED $DATA / / /THIS SUBROUTINE IS CALLED FROM DATF4 - THE REAL $RUN PROCESSOR DAT4, 0 TAD (-12^7 /ZERO OUT CONTROL WORD DCA DEVASC /FOR EACH DEVICE NUMBER TAD (DEVASN-1 DCA OXR1 DEVAS1, DCA I OXR1 ISZ DEVASC JMP DEVAS1 BCLIN /GET THE INPUT LINE DAT41, GETCHR;BCLBUF /GET A CHAR DAT411, ISIT;OPTIS3;DATIS1-1 /IS IT "/" OR <CR>? JMP DAT41 /NO DAT42, L7777 TAD GETPNT /SAVE POINTER TO "/" DCA DEVAST GETCHR;BCLBUF ISNUM JMP DAT411 /IT'S NOT A NUMBER TAD CHAR TAD (-"0 CIA DCA DEVASC TAD DEVASC CIA CLL RAL;RTL TAD DEVASC /NUMBER*7 TAD (DEVASN DCA DEVASC DAT47, GETCHR;BCLBUF /GET ANOTHER CHAR ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="? JMP DAT411 /NO DAT44, TAD I DEVASC /"N" SETS BIT 1 AND (5777 TAD (2000 DCA I DEVASC JMP DAT47 DAT45, TAD I DEVASC /"C" SETS BIT 2 AND (6777 TAD (1000 DCA I DEVASC JMP DAT47 DAT46, TAD GETPNT /SAVE POINTER TO POSSIBLE NAME DCA DEVASP GETCHR;BCLBUF /GET THE NEXT CHAR ISNUM JMP DAT48 /NOT A NUMBER TAD CHAR /SAVE THE NUMBER DCA DEVASS GETCHR;BCLBUF ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR <CR>? DAT48, TAD DEVASP /RESET NAME POINTER DCA GETPNT TAD I DEVASC /ZERO OUT NUMBER AND (7400 DCA I DEVASC TAD DEVASC;IAC /GET POINTER TO DEVICE BLOCK DCA .+2 COLNAM;0 /COLLECT NAME JMP DAT49 /BAD NAME DAT412, TAD I DEVASC /NAME OR NUM OK - SET BIT 0 AND (3777 TAD (4000 DCA I DEVASC DAT49, TAD DEVAST /SQUISH JMS I (BCLSQU JMP DAT41 DAT410, TAD I DEVASC /ADD NUMBER TO CONTROL WORD AND (7400 TAD DEVASS DCA I DEVASC JMP DAT412 DAT43, JMP I DAT4 DEVASP, 0 DEVASC, 0 DEVASS, 0 DEVAST, 0 /SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY: PIPOUT, 0 TAD I PIPOUT /GET ADDRESS OF NAME ISZ PIPOUT DCA PIPPNT OUTNAM /SEND IT PIPPNT, 0 TAD I PIPPNT /GET CHAR OF DEVICE TAD (-2424 /IS IT "TT"? SZA CLA JMP I PIPOUT /NO ISZ PIPPNT TAD I PIPPNT TAD (-3100 /IS IT "Y@"? SZA CLA JMP I PIPOUT /NO SEND;PIPM1 /"/T" JMP I PIPOUT PAGE
/$RUN (FORTRAN IV) DATF4, JMS I (DAT4 /PROCESS DEVICE NUMBER STUFF JMS I (CL4S /DO LOAD STUFF JMP DATL46 DATL4, JMS I (DAT4 OPTION;ZER6 /NO OPTIONS JMP DATL46 DATX4, JMS I (DAT4 /DO DEVICE NUMBER STUFF JMS DATNAM /COLLECT A NAME DATL46, SEND;DTF4M1 /".R PIP_*DATA.DA<BAT:_" CDRTRA /TRANSLATE CARDS SEND;DTF4M2 /"$EOD_.R FRTS_*" OUTNAM;NAMELD /SEND LOADER NAME DATL48, JMP DATL49 /ZEROED OR CREATED IN INIT SEND;DTF4M6 /"_*DATA.DA/4_*" OUTNAM;BATOUT SEND;DTF4M7 /"/5" JMP DTL410 DATL49, SEND;DTF4M8 /"_*/5=4" DTL410, SEND;DTF4M3 /"_*" TAD (-12 /TRANSLATE THE DEVICE NUMBERS DCA DATF4C TAD (DEVASN-7 DCA DATF4P DATL41, TAD (7 TAD DATF4P DCA DATF4P TAD I DATF4P SMA CLA /WAS THIS ONE SPECIFIED? JMP DATL47 /NO TAD I DATF4P AND (377 /WAS IT A NUMBER? SNA JMP DATL42 DCA CHAR /YES - SAVE IT TAD ("=;OUT1 TAD CHAR;OUT1 JMP DATL43 DATL42, TAD DATF4P;IAC /POINT TO NAME DCA .+2 OUTNAM;0 /SEND IT DATL43, TAD I DATF4P /"N"? RAL SMA CLA JMP DATL44 /NO TAD ("<;OUT1 DATL44, TAD I DATF4P /"C"? RTL SMA CLA JMP DATL45 /NO SEND;DTF4M4 /"/C" DATL45, TAD ("/;OUT1 TAD DATF4C TAD ("0+12;OUT1 SEND;DTF4M3 /"_*" DATL47, ISZ DATF4C JMP DATL41 SEND;DTF4M5 /"$_" TAD DATFTN /"$DATA" IS NOW FORTRAN DCA I (DATADR JMP I (BCLHUH DATF4C, 0 DATF4P, 0 DATNAM, 0 OPTION;ZER6 /NO OPTIONS TSTCR;SKP /IS THERE A NAME? JMP DATNO /NO COLNAM;NAMELD /YES - COLLECT IT JMP DATNO /INVALID NAME JMP I DATNAM /RETURN DATNO, SEND;DATNO1 /"?NO PROGRAM TO RUN_" JMS I (BCLHU1;TEXFIN PAGE
/ / / $FORTRAN (FORTRAN II) / / CF2, BCLIN OPTION;CF2OPT /ANALYZE OPTIONS TSTCR /END OF LINE? JMP CF22 CF21, JMS I (MAKNAM;NAME1 /CREATE A NAME JMP CF23 CF22, COLNAM;NAME1 /COLLECT A NAME JMP CF21 /FAIL - CREATE A NAME CF23, SEND;CF2M1 /".R PIP_*" OUTNAM;NAME1 TAD ("<;OUT1 TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN? SMA CLA JMP CF24 /NO OUTNAM;OPSRC+1 TAD (215;OUT1 JMP CF25 CF24, SEND;CF2M2 /"BAT:_" CF25, TAD (FORKEY-15 /FORTRAN CARDS CDF F0 DCA I (KEYADR CDF F1 CDRTRA /TRANSLATE THE CARDS SEND;CF2M3 /"$EOD" TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? SPA CLA JMP CF27 SEND;CF2M4 /"_*" TAD I (OPLIS;RAL /WAS A LISTING FILE GIVEN? SPA CLA JMP CF26 /YES MOV6;BATOUT;OPLIS+1 /NO - USE LISTING DEVICE CF26, JMS I (PIPOUT;OPLIS+1 TAD ("<;OUT1 OUTNAM;NAME1 CF27, SEND;CF2M5 /"_.R FORT_*" OUTNAM;NAME1 TAD I (OPNOL /NOLIST? SPA CLA JMP CF28 /YES TAD I (OPSABR /WAS "/SABR" SPECIFIED? SMA CLA JMP CF28 /NO TAD (",;OUT1 OUTNAM;OPLIS+1 CF28, TAD ("<;OUT1 OUTNAM;NAME1 TAD (215;OUT1 TAD (DATF2 DCA I (DATADR /ENABLE $DATA JMS I (SAVNAM;NAME1 /SAVE THE NAME FOR $LOAD JMP I (BCLHUH /DONE
/ / / $EOD / $MSG / / CEOD, CMSG, JMS SENDKY /OUTPUT THE BCL KEYWORD JMS I (BCLHU1;TEXTRA / / / $JOB / / CJOB, TAD (SAVARA /RESET SAVED NAMES DCA I (SAVPNT DCA I (NAMCNT /ZERO MAKNAM COUNTER TAD DATFTN /$RUN IS NOW FORTRAN DCA I (DATADR BCLIN /SEND THE LINE TO THE BATCH STREAM SEND;MJOB1 /".R FOTP_*FIL???.*/D_" JMS I (BCLHU1;TEXFIN SENDKY, 0 CDF F0 TAD I (KEYVAL CDF F1 TAD (BCLKEY-1 DCA OTEMP1 TAD I OTEMP1 SEND TAD (" ;OUT1 JMP I SENDKY PAGE
/ / / $LOAD (FORTRAN II) / / /THIS SUBROUTINE IS CALLED BY CL2 OR DATF2 CL2S, 0 OPTION;CL2OPT /ANALYZE OPTIONS SEND /".R LOADER_*" OR ".R LOADER_*GENIOX" CL2SX, CL2M1 /OR CL2M1A TAD I (OPINP /WAS "/INPUT" SPECIFIED? SMA CLA JMP CL2S1 SEND;CL2M3 /"/I" CL2S1, TAD I (OPOPT /WAS "/OUTPUT" SPECIFIED? SMA CLA JMP CL2S2 SEND;CL2M4 /"/O" CL2S2, TAD I (OPTWO /WAS "/TWO" SPECIFIED? SMA CLA JMP CL2S3 SEND;CL2M5 /"/H" CL2S3, SEND;CL2M6 /"_*" TAD I (OPLIB;RAL /WAS A LIBRARY SPECIFIED? SMA CLA JMP CL2S4 OUTNAM;OPLIB+1 SEND;CL2M7 /"/L_*" CL2S4, TAD I (OPLIS /WAS "/LIST" SPECIFIED? SMA CLA JMP CL2S6 TAD I (OPLIS;RAL /WAS A NAME GIVEN? SPA CLA JMP CL2S5 /YES MOV6;BATOUT;OPLIS+1 CL2S5, OUTNAM;OPLIS+1 SEND;CL2M8 /"</M_*" CL2S6, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED? SPA CLA JMP CL2S8 CL2S7, JMS I (UNSNAM;NAME1 /GET A SAVED NAME JMP CL2S8 /EMPTY OUTNAM;NAME1 SEND;CL2M6 /"_*" JMP CL2S7 CL2S8, TSTCR;SKP /END OF LINE? JMP CL2S9 /YES COLNAM;NAME1 OUTNAM;NAME1 SEND;CL2M6 /"_*" JMP CL2S8 CL2S9, SEND;CL2M9 /"$_.SAVE " TAD I (OPIMAG;RAL /WAS AN IMAGE FILE NAME GIVEN? SMA CLA JMP CL2S10 /NO - USE DEFAULT TAD I (OPIMAG+1 /WAS A DEVICE GIVEN? SZA CLA JMP CL2S11 /YES TAD (0423 /"DS" DCA I (OPIMAG+1 TAD (1300 /"K" DCA I (OPIMAG+2 CL2S11, MOV6;OPIMAG+1;NAMELD CL2S12, OUTNAM;NAMELD TAD (215;OUT1 JMP I CL2S CL2S10, MOV6;CL2SN2;NAMELD DCA I (NAMCNT JMP CL2S12 /$LOAD CL2, BCLIN JMS CL2S TAD (DATL2 /$DATA DOES NOT DO LOAD DCA I (DATADR JMS I (BCLHU1;TEXFIN PAGE
BCLBUF, ZBLOCK 400 /SPACE FOR A WHOLE BUNCH OF CONTINUATION CARDS BCLSIZ=.-BCLBUF SAVARA, ZBLOCK 6^62 /SPACE FOR SAVED NAMES SAVTOP=. /OPTION LISTS CDEOPT, OPBAS;OPFOR;OPNOL;0 /$DECK CBAOPT, OPNOL;0 /$BASIC CF4OPT, OPSRC;OPNOL;OPLIS;OPRALF;0 /$FORTRAN (F4) CL4OPT, OPIMAG;OPLIS;OPLIB;OPNOA;OPSSYM;0 /$LOAD (F4) CF2OPT, OPSRC;OPNOL;OPLIS;OPSABR;0 /$FORTRAN (F2) CL2OPT, OPINP;OPOPT;OPTWO;OPIMAG;OPLIS;OPLIB;OPNOA;0 /$LOAD (F2) /OPTIONS WITHOUT ASSOCIATED FILE NAME OPBAS, 0004;TEXT "BASIC" /B OPFOR, 0006;TEXT "FORTRAN" /F OPNOL, 0023;TEXT "NOLIST";*.-1 /NOL OPRALF, 0003;TEXT "RALF";*.-1 /R OPNOA, 0023;TEXT "NOAUTO";*.-1 /NOA OPSSYM, 0013;TEXT "SSYMB" /SS OPSABR, 0012;TEXT "SABR";*.-1 /SA OPINP, 0013;TEXT "INPUT" /IN OPOPT, 0023;TEXT "OUTPUT";*.-1 /OUT OPTWO, 0020;TEXT "TWO" /TWO /OPTIONS WITH ASSOCIATED FILE NAME OPSRC, 1002;ZBLOCK 6;TEXT "SRC" /S OPLIS, 1003;ZBLOCK 6;TEXT "LIST";*.-1 /L OPIMAG, 1013;ZBLOCK 6;TEXT "IMAGE" /IM OPLIB, 1024;ZBLOCK 6;TEXT "LIBRARY" /LIB /FILE NAMES NAME1, ZBLOCK 6 NAMELD, ZBLOCK 6 BATOUT, ZBLOCK 6 ZER6, ZBLOCK 6 BATTTY, TEXT "TTY@@@@@@@@@";*.-1 BATLPT, TEXT "LPT@@@@@@@@@";*.-1 CDEDEF, TEXT "@@@@DECK@@@@";*.-1 CBATK, TEXT "BAT@@@@@@@@@";*.-1 CL4DEF, TEXT "@@@@PROG@@LD";*.-1 FILNAM, TEXT "@@@@FIL@@@@@";*.-1 CL2SN2, TEXT "DSK@PROG@@@@";*.-1 /SPACE FOR DEVICE ASSIGNMENTS UNDER FORTRAN 4 DEVASN, ZBLOCK 7^12 /LISTS FOR ISIT CLIS1, -"L;-"O;0 CLIS2, CL4SL;CL4SO DATIS1, DAT42 /"/" DAT43 /<CR> DATIS2, -"N;-"C;-"=;0 DATIS3, DAT44;DAT45;DAT46 DATIS5, DAT410;DAT410;DAT410 OPTIS2, OPTIO8 /"=" OPTIO9 /"," OPTIO9 /"/" OPTIO9 /<CR> OPTIS4, OPTI3A OPTRET OPTIS1, -"= DATIS4, OUTIS1, -", OPTIS3, BCLIS1, -"/;-215 /LIST MUST BE TERMINATED BY A POSITIVE WORD 0 COLIS2, COLDEV /":" COLFIL /"." COLEXT /"/" COLEXT /"," COLEXT /<CR> COLIS1, -":;-".;-"/;-",;-215 /TERMINATE LIST WITH POSITIVE WORD 0 BCLIS2, BCLSQ2 /"/" BCLSQ3 /<CR> OUTIS2, OUTER2 /"," OUTER2 /"/" OUTER2 /<CR> /LIST OF BCL ROUTINE ADDRESSES BCLGO, BCLEOF /FOR FINISHING UP BEFORE CLOSING FILE CBAS /$BAS FORADR, CF4 /$FOR DATADR, DATX4 /$DATA LOAADR, CL4 /$LOAD CJOB /$JOB CMSG /$MSG CDECK /$DECK CEOD /$EOD CERR CERR CERR CERR /LIST OF BCL KEYWORDS BCLKEY, MBAS MFOR MDATA MLOAD MJOB MMSG MDECK MEOD /ERROR MESSAGES OPTERM, TEXT "?INVALID OPTION: /" COLERM, TEXT "?INVALID FILE SPECIFICATION - " BCL11E, TEXT "?_BCL LINE TOO LONG_" /MESSAGES BCLHM1, TEXT "?_" BCL10E, TEXT "_$" CF4M1, CF2M1, CDEM1, TEXT ".R PIP_*" CDEM2, TEXT "<BAT:_" CMEOD, TEXT "$EOD_" CBAM1, TEXT ".R PIP_*PROG.BA<" CBAM2, TEXT "<PROG.BA_" CBAM3, TEXT 'FILE #3:"DATA.DA"\FILEV #4:"' CBAM4, TEXT '"_' PIPM1, TEXT "/T" DTF4M1, DATBM1, TEXT ".R PIP_*DATA.DA<BAT:_" DATBM2, TEXT "$EOD_.R BCOMP_*PROG.BA_" CF2M2, CF4M2, TEXT "BAT:_" CF4M3, TEXT "$EOD_.R F4_*" CF4M4, TEXT "/F" CL4SM1, TEXT ".R LOAD_*" CL4SM2, TEXT "<_*" CL2M7, CL4SM3, TEXT "/L_*" CL4SM4, TEXT "/C_*" CL4SM5, TEXT "/O" DTF4M3, CF2M4, CL2M6, CL4SM6, TEXT "_*" DTF4M5, CL4SM7, TEXT "$_" CL4SM8, TEXT "/S" DTF4M2, TEXT "$EOD_.R FRTS_*" DTF4M4, TEXT "/C" DTF4M6, TEXT "_*DATA.DA/4_*" DTF4M7, TEXT "/5" DTF4M8, TEXT "_*/5=4" DATNO1, TEXT "?NO PROGRAM TO RUN_" CF2M3, TEXT "$EOD" CF2M5, TEXT "_.R FORT_*" CL2M1, TEXT ".R LOADER_*" CL2M1A, TEXT ".R LOADER_*GENIOX" CL2M3, TEXT "/I" CL2M4, TEXT "/O" CL2M5, TEXT "/H" CL2M8, TEXT "</M_*" CL2M9, TEXT "$_.SAVE " DTF2M1, TEXT ".RUN " MBAS, TEXT "$BASIC" MFOR, TEXT "$FORTRAN" MJOB1, TEXT ".R FOTP_*FIL???.*/D_" MEOD, TEXT "$EOD" MJOB, TEXT "$JOB" MMSG, TEXT "$MSG" MDECK, TEXT "$DECK" MLOAD, TEXT "$LOAD" MDATA, TEXT "$RUN"
$