.TITLE BIN1 / / 31 JUL 74 (PDH) ISSUE ' .IODEV ERDV' FOR MAINLINES / 7 JUN 74 (JAF, JAS) IMPLEMENT BLOCK DATA / 17 SEP 73 (PDH) CHANGE DEVICE NUMBER REFERENCES TO SYMBOLIC / 14 SEP 73 (PDH) FIX UP LISTING CLOSING / 11 SEP 73 (PDH) ANNOUNCE ERROR COUNT ON CONSOLE TTY / / / IN WATRAN / ADDRESSES: .GLOBL BASE0,BASE / SWITCHES .GLOBL BINSW,LST,%ISSUE / VARIABLES: .GLOBL %ERCNT / IN IDENT / VARIABLES .GLOBL HEADER,KIND / / IN EXPRES / ADDRESSES: .GLOBL TEMPS / / IN SEARCH / ADDRESS: .GLOBL FLTFLG,VANTED,VANT1 / / IN CALCP / ADDRESSES: .GLOBL TBADDR / SUBROUTINES: .GLOBL CALCP / / IN BIN1 / ADDRESSES: .GLOBL BINAME,BINAM1,D,DATCNT,LOCCNT,DRESS / SUBROUTINES: .GLOBL CLOSER,CLOSPG,INSRT,ITEM4,ITEM5,ITEMIN,NAMEIT .GLOBL OPENER,OPENPG,PROGPT,PUNCH / VARIABLES: .GLOBL ITEM,OPCODE,CLUES / / IN GEARS: / SUBROUTINES: .GLOBL G.STPC,G.CVRT / VARIABLES: .GLOBL NUMS / .EJECT / PUNCH XX / / TEST FOR TEMP. ACC. LAC CLUES AND (TEMPER SNA JMP JOINT / / RELEASE TEMPORARY ACCUMULATOR / LAC TEMPS /POINT AT TEMP ACC TABLE DAC COUNT AGIN LAC* COUNT SAD (770000 JMP JOINT /NOT IN TABLE AND (7777 SAD DRESS JMP BOOB ISZ COUNT JMP AGIN BOOB LAC* COUNT XOR (400000 / INDICATE ACC IS FREE DAC* COUNT / RETURN TO TABLE / PUNCH OUT THE INTERPRETIVE OPCODE AND OTABLE ADDRESS JOINT LAC OPCODE XOR DRESS JMS ITEM4 / PUNCH OUT CODE JMP* PUNCH / EXIT .EJECT / / / THIS PROGRAM WRITES THE BINARY FROM FORTRAN ON .DAT -13 WHICH MUST / BE A FILE ORIENTED DEVICE. THE PROGRAM LENGTHS ARE INSERTED AFTER / THE BINARY FILE HAS BEEN CLOSED. / / THIS BUFFER MUST BE AT LEAST 400 OCTAL LOCATIONS LONG SINCE / BLOCKS OF THE BIN FILE ARE READ INTO IT FOR PROGRAM LENGTH CORRECTION. / THE BUFFERS ARE ARRANGED AS A ROTARY FILE. EACH RECORD IS 26 WORDS LONG / AND EACH BUFFER IS 27 WORDS LONG TO ACCOMODATE THE POINTER .DEC BUFFER .BLOCK 270 / 10 BUFFERS- ADDRESS+2 HDR WORDS+STORAGE ENDBLK=BUFFER+255 .OCT / / CODE;DATCNT;GROUPC;WORDC;BLOCKN;ID.COD;DATWRD;ITEM;CHRTST;CHR1;CHR2;CHR3 INPNT;HDR;OUTPNT;LOCCNT;ITEM2 / / / THIS PROGRAM DOES THE INITIAL SETUPS AND OPENS THE BINARY FILE / IT IS CALLED ONLY ONCE PER JOB. MANY PROGRAMS MAY BE COMPILED IN / ONE JOB AND THEY ALL ARE BUILT UP IN THE SAME FILE. OPENER XX /OPEN A BINARY FILE & INITIALIZE .DEC LAC (BUFFER / ADDRESS OF FIRST FILE DAC INPNT / POINTER TAD (27 / GIVES ADDRESS OF NEXT FILE DAC* INPNT / STORE DAC INPNT / INDEX TO NEXT FILE SAD (BUFFER+243 / IS IT LAST FILE ? SKP JMP .-5 / NO. DO AGAIN DAC OUTPNT / POINTS TO LAST FILE LAC (BUFFER / YES. ADDRESS OF FIRST FILE DAC* INPNT / GOES IN LAST FILE .OCT / DZM CODE /HOLDS LOADER CODES LAW -3 / THERE ARE 3 LOADER CODES AND DATA DAC DATCNT / WORDS PER GROUP LAC (BUFFER / ADDRESS OF 1ST BUFFER JMS SETPTS / SET UP POINTERS FOR RECORD AND INITIALIZE LAC (1 DAC BLOCKN / SET BLOCK COUNTER TO 1 DZM WORDC / SET WORD COUNT JMP* OPENER / / / THIS SUBROUTINE IS CALLED AT THE START OF EACH PROGRAM TO PUNCH / OUT THE PROGRAM NAME. IT SETS A SWITCH TO INDICATE THE CURRENT / RECORD STARTS A PROGRAM OPENPG XX LAW -1 DAC NWPROG / SET SWITCH DZM ITEM / PROGRAM LENGTH ZERO FOR NOW LAC* KIND SAD (BLOCKD JMP ELEVEN LAC (1 / INSERT DUMMY PROGRAM LENGTH BBACK JMS INSRT / TRUE VALUE INSERTED AFTER CLOSE LAC BINAME /RETRIEV 3 LETTERS OF PROGRAM NAME JMS NAMEIT / CONVERT AND PACK LAC BINAME+1 / RETRIEVE LAST 3 LETTERS ONLY3 DZM ITEM LAC* KIND / GET PROGRAM TYPE SAD (MAINK JMP MAINPG LAC* KIND SAD (BLOCKD JMP MAINPG LAC (12 / CODE 10, INTERNAL GLOBAL FOR SUBPROGRAMS ONLY JMS INSRT MAINPG LAC (400000 / DEFINE THE ABOVE AS A PROGRAM NAME DAC ITEM LAC (23 / CODE 19 JMS INSRT LAC (4 DAC* HEADER / MARK IN CASE ITS MAINLINE PROGRAM LAC* KIND SAD (MAINK / IS THIS A MAINLINE? SKP JMP* OPENPG / NO. EXIT LAC (ERDV&777 DAC ITEM / FOR MAINLINE ONLY, LAC (26 / OUTPUT I/O DEVICE REQUEST FOR JMS INSRT / EXECUTION-TIME ERROR DEVICE JMP* OPENPG / THIS KEEPS DOS SYSTEMS HAPPY. / ELEVEN LAC (13 / BLOCK DATA IS CODE 13 JMP BBACK / / THIS SUBROUTINE IS CALLED AFTER THE END OF EACH PROGRAM WHEN ALL THE / INFORMATION HAS BEEN PUNCHED OUT. IT ALLOWS A SHORT RECORD TO BE / WRITTEN OUT IF NECESSARY. CLOSPG XX DAC* SIZEPT / STORE THE PROGRAM SIZE LAC GROUPC JMS WRTBIN JMP* CLOSPG / / ITEM4 ENTERS CODE 04 DATA WORDS INTO BINARY FILE / TIME SAVING OVER 'ITEMIN' IS 4 USEC PER ENTRY / ITEM4 XX DAC ITEM ISZ LOCCNT LAC (04 JMS INSRT JMP* ITEM4 / / / ITEM5 ENTERS CODE 05 DATA WORDS / SAVINGS SAME AS FOR 'ITEM4' / ITEM5 XX DAC ITEM ISZ LOCCNT LAC (05 JMS INSRT JMP* ITEM5 / / / ITEMIN ENTERS ONE CODE AND CORRESPONDING WORD INTO FILE / ALL ENTRIES MADE BY THIS SUBROUTINE CAUSE / THE LOCATION COUNTER TO BE INCREMENTED / ITEMIN XX DAC ITEM / STORE WORD ISZ LOCCNT / COUNT THIS ITEM XCT* ITEMIN / GET CODE AND (77 / 6 BIT CODE JMS INSRT JMP* ITEMIN / RETURN / / / / NAMEIT INSERTS UP TO A 6 CHAR WORD INTO THE BINARY FILE / NAMEIT XX JMS RADX50 / PACK FIRST 3 CHARACTERS DAC ITEM XCT* NAMEIT / GET LAST 3 CHARS SNA / ARE THEY ZERO? JMP ONE / YES. ONLY 1-3 CHARS / JMS RADX50 / NO. 4-6 CHARS, CONVERT. DAC ITEM2 / SAVE IT LAC ITEM XOR (400000 / SIGNIFIES 4-6 CHARS DAC ITEM / LAC (7 JMS INSRT / INSERT FIRST 3 CHARS LAC ITEM2 DAC ITEM LAC (10 / DECIMAL 8 SERT JMS INSRT / INSERT LAST 3 CHARS ISZ NAMEIT / BUMP TO EXIT JMP* NAMEIT / ONE LAC (7 JMP SERT / / / THIS SUBROUTINE CLOSES THE BINARY FILE AND UPDATES THE PROGRAM / SIZES FOR EACH PROGRAM IN THE JOB. IN ORDER TO DO THIS IT MUST CHAIN THROUGH / THE BINARY FILE UNTIL IT REACHES THE CORRECT BLOCK. THEN IT MUST INSERT THE / PROGRAM SIZE AND UPDATE THE CHECKSUM. / THIS SUBROUTINE ALSO ANNOUNCES, ON THE CONSOLE TTY, THE NUMBER OF / DETECTED ERRORS AND/OR WARNINGS. / TELERR 3002 NOERS .ASCII 'NO' ; .LOC .-1 .ASCII '12345 ERRORS'<15> / CLOSER XX LAC NOERS / .ASCII '0' DAC TELERR+2 /IN CASE OF NO ERRORS DZM TELERR+3 /CLEAR ERROR COUNT LAC (6-5 DAC* NUMS /CONVERT 5 DIGITS LAC (TELERR+2 JMS* G.STPC /SET UP BUFFER ADDRESS LAC* %ERCNT /GET ERROR COUNT SZA!STL /SET LINK TO IGNORE LEADING ZEROS JMS* G.CVRT /CONVERT NON-ZERO COUNT TO ASCII .WRITE TTO,2,TELERR,0 /ANNOUNCE ERROR COUNT LAC* LST /WAS LISTING REQUESTED? SZA JMP CLOSELP /YES. ALWAYS CLOSE LISTING DEVICE LAC* %ISSUE /NO. FIND OUT IF ANY ERRORS WERE ISSUED. SNA JMP TSTBIN /NO ERRORS, NO LISTING, DON'T CLOSE. CLOSELP .CLOSE LP / CLOSE THE LISTING FILE TSTBIN LAC* BINSW SNA JMP* CLOSER / NO BINARY FILE WAIT .WAIT DKO / WAIT FOR I/O READY LAC* OUTPNT / LAST FILE HAS BEEN PUNCHED OUT DAC OUTPNT / INDEX TO NEXT FILE SAD INPNT / IS IT THE INPUT FILE ? JMP WRTEOF / YES. TAD (1 DAC FINAL+2 / NO. PUNCH IT OUT FINAL .WRITE DKO,0,FINAL,26 JMP WAIT / WRTEOF .CLOSE DKO / WRITES EOF MARK / / MUST NOW INSERT THE OCTAL SIZE OF THE PROGRAM IN THE BINARY FILE / LAC D DAC FSTAT1+2 / SET UP ADDRESS IN FSTAT .INIT DKO,0,OPENER /INITIALIZE FOR READ FSTAT1 .FSTAT DKO,D / GET FIRST BLOCK IN ACC DAC ENDBLK / SAVE IN CHAIN LOCATION DZM CHR1 / MARK THAT NO BLOCK HAS BEEN READ YET / SET UP POINTERS TO EACH PROGRAM INFO IN TURN LAC* BASE0 / ADDRESS WHERE INFO TABLE STARTS SKP NEXPRG LAC CHR3 JMS PROGPT / SET UP POINTERS DAC CHR3 / SAVE ADDRESS TO CHECK FOR END AND RESETTING LAC* BLKPT / GET BLOCK NUMBER WHERE PROGRAM STARTS JMS GETBLK / GO GET BLOCK / WE HAVE BLOCK, CALCULATE POSITION TO BE CHANGED AND CHECKSUM LOCATION LAC* WORDPT / LOCATION OF START OF RECORD TAD (BUFFER+1 DAC BLKPT / POINTS AT CHECKSUM TAD (2 DAC WORDPT / POINTS AT LOCATION TO INSERT SIZE LAC* SIZEPT / GET SIZE OF PROGRAM DAC* WORDPT / STUFF IN TABLE CMA TAD (1 TAD* BLKPT / ADD IN CHECKSUM DAC* BLKPT / RESTORE CHECKSUM .INIT DKO,1,COUT / INITIALIZE FOR WRITING BLOCK BACK WRTRAN .TRAN DKO,1,0,BUFFER,256 .CLOSE DKO / THE .CLOSE PERFORMS A .WAIT AUTOMATICALLY LAC* BASE TAD (-3 SAD CHR3 / ARE WE AT END OF TABLE? COUT JMP* CLOSER / YES. JMP NEXPRG / NO, GO DO NEXT PROGRAM / / THIS PROGRAM CHAINS DOWN THE BINARY FILE TO FIND THE ONE TO BE ALTERED GETBLK XX DAC CHR2 / SAVE NEW BLOCK # CMA TAD (1 TAD CHR1 SNA / DO WE HAVE THAT BLOCK ALREADY JMP* GETBLK / YES. WE HAVE IT FROM LAST READ DAC COUNT / NO. GIVES NUMBER OF BLOCKS TO CHAIN THROUGH / READ IN BLOCKS UNTIL COUNT GOES TO ZERO .INIT DKO,0,COUT NEXBLK LAC ENDBLK / GET ADDRESS OF NEXT BLOCK DAC RDTRAN+2 DAC WRTRAN+2 RDTRAN .TRAN DKO,0,0,BUFFER,256 .WAIT DKO ISZ COUNT / HAVE WE CORRECT ONE YET? JMP NEXBLK / NO. LAC CHR2 DAC CHR1 / SAVE BLOCK NUMBER OF CURRENT BLOCK .CLOSE DKO JMP* GETBLK / / / CONVERTS THE THREE SIX BIT CHARACTERS IN AC TO RADIX 50 CHARACTERS / IN AC. ZERO OR NULL SIGNIFIES END OF WORD. IT ALSO TRANSLATES / INTERNAL COMPILER CODE TO 6 BIT OCTAL CODE USED BY LOADER / CHR=LLS!1006 / CLA THEN SHIFTS LEFT PUTTING CHAR INTO ACC / RADX50 XX DZM CHRTST / IF NON ZERO ON RETURN ONE OR MORE LMQ // NULL CHR DAC CHR1 CHR DAC CHR2 CHR DAC CHR3 LAC CHR1 JMS CONVRT / CHANGE OCTAL CODE MUL 50 / SAVE PRODUCT IN MQ LAC CHR2 JMS CONVRT DAC CHR2 / SAVE FOR ADD LACQ TAD CHR2 MUL 50 LAC CHR3 JMS CONVRT DAC CHR3 LACQ TAD CHR3 JMP* RADX50 / RETURN / / / / CONVRT XX SNA / IS CHARACTER NULL JMP NULL / YES TAD (-64 / ALL DIGITS NOW HAVE CODE .GE. 0 SMA / IS IT CHARACTER TAD (1 / NO! OPEN SPACE FOR '.' TAD (34 / NOW CORRECT SAD (47 / IS IT POINT LAC (34 / YES CLL JMP* CONVRT NULL ISZ CHRTST / NULL ENCOUNTERED JMP* CONVRT / / / THIS SUBROUTINE ENTERS THE CONTENTS OF ITEM INTO THE BINARY FILE / UNDER THE LOADER CODE WHICH IS IN THE ACC WHEN ENTERING THE SUBROUTINE. INSRT XX / STORE CODE & ITEM IN LOADER FORMAT GETCOD XOR CODE /OR PREVIOUS CODES ISZ DATCNT / IS GROUP FULL JMP MORIDS / NO WILL ACCEPT MORE I.D.'S DAC* ID.COD / YES GROUP IS FULL LAC ITEM / STORE CORRESPONDING WORD DAC* DATWRD ISZ GROUPC / COUNT THIS GROUP / IF RECORD IS FULL IT MUST BE WRITTEN OUT LAC GROUPC SAD (6 JMP PUTBIN / RECORD IS FULL LAC ID.COD / NOT FULL, UPDATE POINTERS TO NEXT GROUP TAD (4 / BLOCK DAC ID.COD TAD (1 DAC DATWRD /POINT AT 1ST WORD OF NEXT GROUP SKP PUTBIN JMS WRTBIN / GO WRITE RECORD OUT RESET LAW -3 / RESET FOR NEXT THREE CODES DAC DATCNT DZM CODE JMP* INSRT / RETURN / / INSERT CODE AND DATA WORD IN GROUP MORIDS ALSS+6 / MAKE ROOM FOR NEXT CODE DAC CODE / ZERO'S ARE SHIFTED IN LAC ITEM DAC* DATWRD ISZ DATWRD / POINT TO NEXT FREE WORD JMP* INSRT / / THE I/O ROUTINE HAS BUFFERS EACH 32 OCTAL WORDS LONG / INCLUDING HEADER WORDS / ALL BUFFERS THAT CONTAIN ANY DATA ARE FREE FOR OUTPUT EXCEPT THE ONE / BEING FILLED. / ENTER THE SUBROUTINE WITH THE NUMBER OF GROUPS IN THE AC. WRTBIN XX MUL!20000 / CLEARS LINK ALSO 4 / GIVES # OF WORDS LACQ TAD (2 / ACCOUNT FOR HEADER WORDS DAC COUNT / SAVE FOR UPDATING WORD COUNT LLS 10 / A SHIFT OF 9 BITS LEFT AND A DIVISION BY TWO DAC* HDR / STORE IN HEADER WORD OF RECORD / CHECK WHICH BLOCK THIS RECORD WILL GO INTO. IF THIS RECORD BEGINS / A PROGRAM THEN STORE THE BLOCK AND WORD COUNT. LAC WORDC TAD COUNT TAD (-377 / LAST WORD OF BLOCK MAY NOT BE USED SNA!SPA / DOES THIS RECORD FIT IN CURRENT BLOCK JMP CHKSTP / YES. ISZ BLOCKN / NO DZM WORDC / SET TO START OF NEW BLOCK / NOW CHECK IF RECORD STARTS A NEW PROGRAM CHKSTP ISZ NWPROG JMP NOTNEW / NO IT DOESN'T LAC BLOCKN / YES. STORE INFO DAC* BLKPT LAC WORDC DAC* WORDPT / COUNT THIS RECORD NOW NOTNEW LAC WORDC TAD COUNT DAC WORDC LAC* BINSW SNA JMP NOBNRY / NO BINARY FILE, GO RESET POINTERS .WAITR DKO,BUSY / IS I/O BUSY FREED LAC* OUTPNT / NO. LAST FILE HAS FINISHED DAC OUTPNT / INDEX TO NEXT FILE TAD (1 DAC WRIT+2 / INSERT RECORD ADDRESS FOR PRINTING WRIT .WRITE DKO,0,OUTPNT,26 / BUSY LAC* INPNT / IS THE NEXT FILE THE ONE BEING PUNCHED SAD OUTPNT JMP HESTAT / YES. FILLING HAS CAUGHT UP TO PUNCHING JMS SETPTS / SET UP POINTERS JMP* WRTBIN / HESTAT .WAIT DKO / WAIT UNTIL FILE IS FINISHED OUTPUT JMP FREED / NOBNRY LAC INPNT / JUST REUSE SAME BINARY RECORD JMS SETPTS JMP* WRTBIN / / THIS SUBROUTINE SETS UP OR ADVANCES THE POINTERS FOR EACH GROUP SETPTS XX DAC INPNT TAD (1 DAC HDR / POINTS TO 1ST WORD OF HEADER TAD (2 DAC ID.COD / POINTS TO CODE WORD TAD (1 DAC DATWRD / POINTS TO 1ST DATA WORD DZM GROUPC / RESET GROUP COUNT JMP* SETPTS / / THIS SUBROUTINE ADVANCES THE POINTERS TO THE PROGRAM SIZE STORAGE PROGPT XX DAC BLKPT / ADDRESS OF BLOCK NUMBER TAD (1 DAC WORDPT / ADDRESS OF WORD IN BLOCK TAD (1 DAC SIZEPT / ADDRESS WHERE SIZE OF PROGRAM IS STORED TAD (1 JMP* PROGPT / / / / / STORAGE FOR THE FILE OR SUBROUTINE NAME BINAME .DSA 0 BINAM1 .DSA 0 .SIXBT 'BIN' / FILE EXTENSION / DRESS 0 CLUES 0 OPCODE 0 COUNT 0 / / THE NEXT THREE LOCATIONS ARE POINTERS TO THE LOCATIONS IN WHICH / ARE STORED THE INFO NECESSARY FOR UPDATING THE PROGRAM SIZES BLKPT 0 / POINTS TO BLOCK NUMBER WORDPT 0 / POINTS TO WORD IN BLOCK SIZEPT 0 / POINTS TO THE PROGRAM SIZE LOCATION NWPROG 0 / SWITCH TO INDICATE A RECORD STARTS A PROGRAM / .END