File: IOPAK.PA of Tape: Sources/Focal/s8
(Source file text)
/GENERAL CHARACTER I/O ROUTINES FOR BLEEP /CALLED AS FOLLOWS: /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE /JMS I (ICHAR READS A CHARACTER /ERROR RETURN /AC>0 IF END OF FILE, AC<0 IF READ ERROR /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR /JMS I (OCHAR OUTPUTS A CHARACTER /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT /JMS I (OCLOSE CLOSES THE OUTPUT FILE /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC /PARAMETERS NEEDED: INFPTR=22 INEOF=23 INBUF=3000 /ADDRESS OF INPUT BUFFER INCTL=1420 /INPUT BUFFER CONTROL WORD OUBUF=0000 /ADDRESS OF OUTPUT BUFFER OUCTL=5420 /OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE) INRECS=6 /[INCTL/256] INDEVH=6600 /ADDRESS OF PAGE FOR INPUT HANDLER OUDEVH=7200 /ADDRESS OF PAGE FOR OUTPUT HANDLER ORIGIN=2000 DCB=7760 /ASSUMES I/O MONITOR IS RESIDENT IN CORE. /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD. INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER FIELD 1 *ORIGIN IN7400, 7400 IOPEN, 0 CLA CMA DCA INCHCT /SET INCHCT TO FORCE A READ ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE TAD (7617 DCA INFPTR /RESET FILE POINTER RDF TAD INCDIF DCA .+1 INPTR, HLT /RESTORE CALLING FIELDS JMP I IOPEN ICHAR, 0 IN7600, 7600 RDF TAD INCDIF DCA INRTRN /SAVE CALLING FIELDS INCHAR, CDF INFLD ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH ISZ INCHCT INJMPP, JMP INJMP TAD INEOF SNA CLA /DID LAST READ YIELD END-OF-FILE? JMP INGBUF /NO - DO ANOTHER GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE JMP EOFERR /NO FILE TO OPEN INGBUF, TAD INCTR CLL TAD (INRECS SNL DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED SZL /IS THIS THE LAST READ? ISZ INEOF /YES - SET END-OF-FILE FLAG /NOT END-OF-FILE IF INPUT DEVICE /IS NON-FILE STRUCTURED! CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ RTR /FROM THE AMOUNT OF THE OVERFLOW RTR /(IF ANY) AND THE STANDARD CONTROL WORD TAD (INCTL+1 DCA INCTLW INCDIF, CDF CIF 0 CDF 10 JMS I INHNDL /CALL THE DEVICE HANDLER INCTLW, 0 INBUFP, INBUF INREC, 0 JMP INERRX INBREC, TAD INREC TAD (INRECS DCA INREC /UPDATE THE RECORD NUMBER TAD INCTLW AND IN7600 CLL RAL TAD INCTLW AND IN7600 CMA DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT TAD INJMPP DCA INJMP /RESET THE CHARACTER SWITCH TAD INBUFP DCA INPTR /AND THE WORD POINTER JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE SMA CLA /WHICH TYPE WAS IT? JMP INBREC /END OF FILE - RESUME THY PROCESSING INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC EOFERR, JMP INRTRN INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH JMP ICHAR1 JMP ICHAR2 ICHAR3, TAD INJMPP DCA INJMP TAD I INPTR IN200, AND IN7400 CLL RTR RTR /COMBINE THE HIGH-ORDER FOUR BITS OF TAD INCTLW RTR /THE TWO WORD TO FORM THE THIRD CHARACTER RTR ISZ INPTR JMP INCOMN ICHAR2, TAD I INPTR AND IN7400 DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR ISZ INPTR /BUMP THE WORD POINTER ICHAR1, TAD I INPTR INCOMN, AND (377 TAD (-232 INCTZF, SNA /IS THE CHARACTER A ^Z? JMP GETNEW /YES - GET A NEW FILE TAD (232 /RESTORE THE CHARACTER ISZ ICHAR /BUMP RETURN TO NORMAL RETURN INRTRN, 0 /RESTORE CALLING FIELDS JMP I ICHAR /AND RETURN /IOPEN IS UNNECESSARY. INNEWF, -1 /ROUTINE TO OPEN NEW INPUT FILE INCHCT=INNEWF CDF 10 TAD (INDEVH+1 DCA INHNDL /INITIALIZE HANDLER ADDRESS TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY SNA /ANY MORE? JMP I INNEWF /NO - OUT OF INPUT JMS I IN200 1 /ASSIGN, FETCH HANDLER INHNDL, 0 HLT /HUH? TAD I INFPTR AND (7760 /GET LENGTH PART OF WORD SZA /LENGTH OF 0 MEANS LENGTH >=256 TAD (17 /ADD HIGH-ORDER BITS CLL CML RTR RTR DCA INCTR /STORE LENGTH OF FILE ISZ INFPTR TAD I INFPTR DCA INREC /STORE STARTING RECORD NUMBER OF FILE ISZ INFPTR DCA INEOF /ZERO END-OF-FILE FLAG ISZ INNEWF JMP I INNEWF INCTR=IOPEN PAGE OOPEN, 0 /OPEN OUTPUT FILE OU7600, 7600 RDF TAD OUCDIF DCA OORETN TAD OU7601 DCA OUBLK TAD (OUDEVH+1 DCA OUHNDL CDF 10 TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY AND (17 /STRIP OFF ANY LENGTH INFO SNA /IS THERE AN OUTPUT DEVICE? JMP ONOFIL /NO - INHIBIT OUTPUT JMS I (200 1 /ASSIGN, FETCH HANDLER OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY HLT /HUH? OUENTR, TAD I OU7600 JMS I (200 3 /ENTER OUTPUT FILE OUBLK, 7601 /REPLACED WITH STARTING BLOCK OUELEN, 0 /REPLACED WITH LENGTH OF HOLE JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH DCA OUCCNT DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG JMS I (OUSETP ISZ OOPEN OORETN, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OOPEN OEFAIL, TAD I OU7600 AND (7760 /GET REQUESTED LENGTH SNA CLA /WAS IT AN INDEFINITE REQUEST JMP ONTERR /YES - CANNOT ENTER THE FILE TAD I OU7600 AND (17 /MAKE THE REQUESTED LENGTH ZERO DCA I OU7600 JMP OUENTR /TRY, TRY AGAIN ONTERR, CLA CLL CML RAR JMP OORETN /TAKE THE ERROR RETURN WITH AC<0 ONOFIL, ISZ I (OUTINH JMP OORETN /TAKE THE ERROR RETURN WITH AC=0 OUTDMP, 0 DCA OUCTLW /STORE THE CONTROL WORD CDF 10 TAD I (OUTINH SZA CLA JMP OUNOWR TAD OUCCNT SNA ISZ OUCTLW TAD OUBLK DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER TAD OUCTLW CLL RTL RTL RTL AND (17 /COMPUTE THE NUMBER OF RECORDS TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE DCA OUCCNT TAD OUCCNT CLL CML TAD OUELEN SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH? JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR OUCDIF, CDF CIF 0 CDF 10 JMS I OUHNDL OUCTLW, 0 OUBUF OUREC, 0 SKP OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN JMP I OUTDMP OCLOSE, 0 CDF 10 TAD I (OUTINH SZA CLA /IS OUTPUT INHIBITED? JMP OCISZ /YES - CLOSE IS A NOP TAD (232 /OUTPUT A ^Z JMS I (OCHAR JMP OCRET JMS I (OCHAR JMP OCRET FILLLP, JMS I (OCHAR JMP OCRET TAD (177 /WHOLE RECORD AND I (OUDWCT SZA CLA /UP TO THE BOUNDARY YET? JMP FILLLP /NO - FILL WITH ZEROS TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT TAD (OUCTL&3700 SNA /A FULL WRITE LEFT? JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT JMS OUTDMP JMP OCRET /AN ERROR OCCURRED WHILE DUMPING THE BUFFER NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER JMS I (200 4 /CLOSE THE OUTPUT FILE OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME OUCCNT, 0 SKP /ERROR WHILE CLOSING THE FILE - BAD! OCISZ, ISZ OCLOSE OCRET, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OCLOSE PAGE OUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS CIA /PAL10 IS DEFINITELY NOT NICE DCA OUDWCT / TAD (OUBUF IFNZRO OUBUF <ERROR!> /V3 DCA OUPTR /INITIALIZE WORD POINTER TAD OUJMPE DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH JMP I OUSETP OCHAR, 0 AND (377 DCA OUTEMP RDF TAD (CDF CIF 0 DCA OUCRET TAD OUTINH SZA CLA /IS THERE AN OUTPUT FILE? JMP OUCOMN /NO - EXIT OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD ISZ OUJMP /BUMP THE CHARACTER SWITCH OUJMP, HLT /THREE WAY CHARACTER SWITCH JMP OCHAR1 JMP OCHAR2 OCHAR3, TAD OUTEMP CLL RTL RTL AND (7400 TAD I OUPOLD DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH /ORDER 4 BITS OF THIRD CHAR TAD OUTEMP CLL RTR RTR RAR AND (7400 TAD I OUPTR DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS TAD OUJMPE DCA OUJMP /RESET SWITCH ISZ OUPTR ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS JMP OUCOMN TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE JMS I (OUTDMP /DUMP THE BUFFER JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN JMS OUSETP /RE-INITIALIZE THE POINTERS JMP OUCOMN OCHAR2, TAD OUPTR DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD OCHAR1, TAD OUTEMP DCA I OUPTR OUCOMN, ISZ OCHAR OUCRET, HLT /RESTORE CALLING FIELDS JMP I OCHAR OUTEMP, 0 OUPOLD, 0 OUPTR, 0 OUJMPE, JMP OUJMP OUDWCT, 0 OUTINH, 0 OTYPE, 0 RDF TAD (CDF CIF 0 DCA OTRTN CDF 10 TAD I (7600 AND (17 TAD (DCB-1 DCA OUTEMP TAD I OUTEMP OTRTN, HLT JMP I OTYPE CTCTST, 0 TAD (200 /V3 KRS TAD (-203 SNA CLA /IS THE TELETYPE BUFFER A ^C KSF /WITH THE TELETYPE FLAG ON? JMP I CTCTST /NO LEAVE, CDF CIF 0 /YES - GO TO MONITOR JMP I (7600 /THROUGH THE "SAVE CORE" RETURN PAGE $$$