; TITLE IO SERVICE FOR FORTRAN CALLING PROGRAMS SUBTTL GCI-GENERAL CHANNEL INITIALIZATION ENTRY GCI EXTERNAL JOBFF Q=16 GSACS=6 NOCH=4 ;HIGHEST LEGAL CHANNEL NUMBER. ;GENERAL CHANNEL INITIALIZER ;CALL GCI(N1,N2,N3,N4,N5,N6) ;INPUT - N1 = DEVICE NAME IN ASCII ; N2 = CHANNEL NUMBER ; N3 = 0 - INPUT ONLY ; 1 - OUTPUT ONLY ; 2 - BOTH ; N4 = NOT USED ; N5 = 0 - ASCII MODE ; 1 - IMAGE BINARY MODE ;OUTPUT - N6 = 0 - NO ERROR ; 1 - N2 OUT OF RANGE ; 2 - ILLEGAL DEVICE ; 3 - N3 OUT OF RANGE GCI: 0 MOVE 1,JOBFF ;SAVE JOBFF MOVEM 1,SJOBFF ;FOR MONITOR MOVE 1,@(Q) ;N1-DEV NAME MOVEM 1,N1 SETZM N6 ;SET ERROR RET. MOVE 1,@1(Q) ;N2-CHAN NO. JUMPL 1,GCI11 ;TEST IF LEGAL CAILE 1,NOCH JRST GCI11 MOVEM 1,N2 GCI1: SETZM M1 ;CLEAR DEV NAME SETZM M2 ;AND BUF HEAD NAME. MOVE 2,PBF(1) ;GET ADR OF BUF RING MOVEM 2,JOBFF ;SET JOBFF MOVE 1,[JUMP] MOVEM 1,M5 ;NOP THE INBUF AND MOVEM 1,M6 ;OUTBUF OPS MOVE 1,[POINT 7,N1] MOVE 2,[POINT 6,M1] GCI3: ILDB 3,1 ;CONVERT DEV NAME JUMPE 3,GCI2 SUBI 3,40 ;TO SIXBIT JUMPE 3,GCI2 IDPB 3,2 ;STOP ON BLANK OR NULL. JRST GCI3 GCI2: MOVE 1,@2(Q) ;N3-IN OR OUT SIDES JUMPL 1,GCI12 CAILE 1,2 JRST GCI12 MOVE 2,N2 ;GET CHAN# HRLZ 4,N2 LSH 4,5 GCI4: JUMPG 1,GCI5 ;JUMP IF NOT INPUT ONLY. HRR 3,PIO(2) ;GET BUF HEAD ADR HRRM 3,M2 ;SET FOR INIT OP MOVE 3,4 ADD 3,[INBUF 0,2] ;FORM INBUF OP MOVEM 3,M5 JRST GCI6 ;GO FORM INIT GCI5: CAIE 1,1 ;TEST N3 JRST GCI7 ;GO IF BOTH IN AND OUT. HLL 3,PIO(2) ;OUT ONLY, GET BUF HEAD HLLM 3,M2 ;SET FOR INIT OP. GCI13: MOVE 3,4 ADD 3,[OUTBUF 0,2] ;FORM OUTBUF MOVEM 3,M6 JRST GCI6 ;GO FORM INIT. GCI7: SKIPE 2 ;COME HERE IF BOTH IN AND OUT. JRST GCI12 MOVE 3,PIO(2) MOVEM 3,M2 ;GET BOTH BUF HEADS MOVE 3,4 ADD 3,[INBUF 0,2] ;FORM INBUF MOVEM 3,M5 JRST GCI13 ;GO FORM OUTBUF GCI6: MOVE 3,4 ;FORM INIT ADD 3,[INIT 0,1] SKIPE @4(Q) ;TEST N5 FOR DATA MODE. ADDI 3,7 ;SET TO IMAGE IF NOT ASCII MOVEM 3,M0 M0: 0 ;INIT M1: 0 ;DEV NAME M2: 0 ;BUF HEAD ADR. JRST GCI10 ;ERROR ON INIT. M5: JUMP ;INBUF OPERATOR M6: JUMP ;OUTBUF OPERATOR GCI14: MOVE 1,N6 GCI15: MOVEM 1,@5(Q) ;SET N6 IN USER AREA. MOVE 1,SJOBFF ;RESTORE JOBFF MOVEM 1,JOBFF JRA Q,6(Q) ;RETURN GCI10: MOVEI 1,2 ;N6=2. BAD DEVICE JRST GCI15 GCI11: MOVEI 1,33 ;N6=1. ILLEGAL CHAN# JRST GCI15 GCI12: MOVEI 1,3 ;N6=3 N3 BAD. JRST GCI15 STAT: 0 ;STATUS GSAC: BLOCK 7 ;AC STORAGE N1: 0 ;TEMP N2: 0 N3: 0 N4: 0 N5: 0 N6: 0 PIO: XWD OB0,IB0 ;POINTERS TO BUFF HEADS XWD OB1,OB1 XWD OB2,OB2 XWD OB3,OB3 XWD OB4,OB4 OB0: BLOCK 3 ;OUT BUF HEADS FOR OB1: BLOCK 3 ; EACH CHANNEL. OB2: BLOCK 3 OB3: BLOCK 3 OB4: BLOCK 3 IB0: BLOCK 3 ;BUF HEAD FOR CHANNEL 0. ;IN BUF HEADS FOR IB1=OB1 ;EACH CHANNEL. SAME AS IB2=OB2 ;OUTPUT SINCE ONLY ONE SIDE OF IB3=OB3 ;CALL CHANNEL CAN BE OPEN. BF0: BLOCK 25*4+1 ;IO BUFFERS FOR EACH BF1: BLOCK 204*2 ; CHANNEL. BF2: BLOCK 204*2 BF3: BLOCK 204*2 BF4: BLOCK 204*2 PBF: EXP BF0 ;POINTERS TO BUFFERS FOR EXP BF1 ; SETTING JOBFF. EXP BF2 EXP BF3 EXP BF4 SJOBFF: 0 ;STORE FOR JOBFF SUBTTL OFIN ENTRY OFIN ;OPEN FILE FOR INPUT ;CALL OFIN(N1,N2,N3) ;INPUT - N1 = CHANNEL NUMBER ; N2 = FILE NAME UP TO 4 ASCII CHARACTERS ;OUTPUT - N3 = 0 - NO ERROR ; 1 - N1 OUT OF RANGE ; 2 - NO DEVICE ON CHANNEL ; 3 - FILE READ PROTECTED ; 4 - NO SUCH FILE ; 5 - GENERAL ERROR OFIN: 0 MOVE 4,@(Q) ;N1 - CHAN# MOVEM 4,N1 MOVE 5,@1(Q) ;N2 - FILENAME MOVEM 5,N2 SETZM N3 ;INIT ERROR RET. JUMPL 4,OFI6 ;TEST FOR OK CHAN# CAILE 4,NOCH JRST OFI6 OFI1: MOVE 3,PLU(4) ;GET ADR OF LOOKUP OPERANDS SETZM (3) ;CLEAR FIRST TWO OPS SETZM 1(3) ; OF LOOKUP MOVE 1,[POINT 6,0(3)] MOVE 6,[POINT 7,N2] OFI2: ILDB 2,6 ;CONVRT FILENAME JUMPE 2,OFI3 SUBI 2,40 ; TO SIXBIT JUMPE 2,OFI3 IDPB 2,1 JRST OFI2 OFI3: LSH 4,5 MOVSS 4 ;GET CHAN # ADD 4,[LOOKUP 0,0] ;FORM LOOKUP ADD 4,3 MOVEM 4,OFI4 OFI4: 0 ;EXECUTE LOOKUP JRST OFI5 ;ERROR MOVE 1,N3 OFI7: MOVEM 1,@2(Q) ;SET N3 OFI9: JRA Q,3(Q) ;RETURN OFI5: LDB 2,[POINT 3,1(3),35] ;GET ERROR INDICATOR SETZ 1, ;FROM LOOKUP AND SET CAIN 2,7 ;N3 ACCORDINGLY MOVEI 1,2 ;N3=2. NO DEV ON CHAN CAIN 2,1 MOVEI 1,4 ;N3=4. NO SUCH FILE. CAIN 2,0 MOVEI 1,4 CAIN 2,2 MOVEI 1,3 ;N3=3. FILE READ PROTECTED OFI8: CAIN 1,0 MOVEI 1,5 ;SOFTWARE ERROR. AC1 MUST BE JRST OFI7 ; SET BY THIS TIME. OFI6: MOVEI 1,1 ;N3=1. BAD CHAN# JRST OFI7 ;DATA PLU: EXP LU0,LU1,LU2,LU3,LU4 ;ADRS OF LOOKUP OPERANDS. LU0: EXP 0,0,0,0 LU1: EXP 0,0,0,0 LU2: EXP 0,0,0,0 LU3: EXP 0,0,0,0 LU4: EXP 0,0,0,0 SUBTTL OFOUT ENTRY OFOUT ;OPEN FILE FOR OUTPUT ;CALL OFOUT(N1,N2,N3) ;INPUT - N1 = CHANNEL NUMBER ; N2 = FILE NAME ;OUTPUT - N3 = 0 - NO ERROR ; 1 - N1 OUT OF RANGE ; 2 - NO DEVICE ON CHANNEL ; 3 - FILE WRITE PROTECTED ; 4 - BAD FILE NAME ; 5 - GENERAL ERROR ; 6 - FILE IS ACTIVE. OFOUT: 0 MOVE 4,@(Q) ;N1 - CHAN# MOVEM 4,N1 MOVE 5,@1(Q) ;N2 - FILENAME MOVEM 5,N2 SETZM N3 ;INIT ERROR RET JUMPL 4,OFI6 ;TEST FOR OK CHAN # CAILE 4,NOCH JRST OFI6 OFO1: MOVE 3,PEN(4) ;GET ADR OF ENTER OPS. SETZM (3) SETZM 1(3) MOVE 1,[POINT 6,0(3)] MOVE 6,[POINT 7,N2] OFO2: ILDB 2,6 ;CONVRT FILENAME TO SIXBIT. JUMPE 2,OFO3 SUBI 2,40 JUMPE 2,OFO3 IDPB 2,1 JRST OFO2 OFO3: LSH 4,5 MOVSS 4 ;CHAN # ADD 4,[ENTER 0,0] ;FORM ENTER ADD 4,3 MOVEM 4,OFO4 OFO4: 0 ;EXECUTE ENTER JRST OFO5 ;ERROR MOVE 1,N3 ;GO EXIT JRST OFI7 OFO5: LDB 2,[POINT 3,1(3),35] ;GET ERROR RET FROM ENTER SETZ 1, ;AND SET N3 CAIN 2,7 MOVEI 1,2 CAIN 2,1 MOVEI 1,4 CAIN 2,3 MOVEI 1,6 CAIN 2,2 MOVEI 1,3 CAIN 2,0 MOVEI 1,4 JRST OFI8 ;DATA PEN: EXP EN0,EN1,EN2,EN3,EN4 ;ADRS OF ENTER OPS. EN0: EXP 0,0,0,0 EN1: EXP 0,0,0,0 EN2: EXP 0,0,0,0 EN3: EXP 0,0,0,0 EN4: EXP 0,0,0,0 SUBTTL CLO ENTRY CLO ;CLOSE A CHANNEL ;CALL CLO(N1,N2,N3) ;INPUT - N1 = CHANNEL NUMBER ; N2 = 0 - INPUT SIDE ; 1 - OUTPUT SIDE ; 2 - BOTH SIDES ;OUTPUT - N3 = 0 - NO ERROR ; 1 - N1 OUT OF RANGE ; 2 - DATA ERROR ; 3 - N2 OUT OF RANGE CLO: 0 SETZ 4, ;INIT ERROR RET. MOVE 1,@(Q) ;N1-CHAN# JUMPL 1,OFI6 ; TEST IF OK. CAILE 1,NOCH JRST OFI6 CLO1: SETO 3, MOVE 2,@1(Q) ;N2 - WHICH SIDE TO CLOSE CAIN 2,0 MOVEI 3,1 ;INPUT ONLY CAIN 2,1 MOVEI 3,2 ;OUTPUT ONLY CAIN 2,2 SETZ 3, ;BOTH JUMPL 3,CLO2 ;ERROR IF AC3 STILL NEG. CLO3: LSH 1,5 MOVSS 1 MOVEM 1,N1 ADD 1,[CLOSE 0,0] ;FORM CLOSE ADD 1,3 XCT 1 ;EXECUTE IT. CLO4: MOVE 1,N1 ADD 1,[STATZ 0,740000] ;FORM STATZ XCT 1 ;TEST FOR ERRORS MOVEI 4,2 ;N3=2. DATA ERROR. MOVE 1,N1 ADD 1,[GETSTS 0,6] XCT 1 MOVEM 6,STAT CLO5: MOVEM 4,@2(Q) ;SET N3 JRST OFI9 ;EXIT CLO2: MOVEI 4,3 ;N3=3. N2 BAD. JRST CLO5 SUBTTL FIN ENTRY FIN ;FINISH A CHANNEL ;CALL FIN(N1,N2) ;INPUT - N1 = CHANNEL NUMBER ;OUTPUT - N2 = 0 - NO ERROR ; 1 - N1 OUT OF RANGE ; 2 - DATA ERROR FIN: 0 MOVEM 1,N6 ;SAVE AC1 MOVE 1,@(Q) ;N1 - CHAN# MOVEM 1,N4 JSA Q,CLO ;CLOSE EXP N4 ;CHAN N1 EXP [2] ; BOTH SIDES EXP N5 ; RET ERROR IN N5. SKIPE N5 JRST FIN1 ;EXIT IF ERROR IN CLOSE. MOVE 1,@(Q) ;GET CHAN# XCT REL(1) ;EXECUTE A RELEASE FIN1: MOVE 1,N5 MOVEM 1,@1(Q) ;SET ERROR RET MOVE 1,N6 ;RESTORE AC1 JRA Q,2(Q) ;EXIT ;DATA REL: RELEAS 0, RELEAS 1, RELEAS 2, RELEAS 3, RELEAS 4, SUBTTL CRC ENTRY CRC ;CONSOLE-READ A CHARACTER ;CALL CRC(N1) ;OUTPUT - N1 HOLDS A CHARACTER, RIGHT ADJUSTED CRC: 0 SOSG IB0+2 ;DEC BYTE CT INPUT 0, ;INPUT IF NO DATA. ILDB 0,IB0+1 ;GET DATA MOVEM 0,@(Q) ;STORE JRA Q,@1(Q) ;EXIT SUBTTL CWC ENTRY CWC ;CONSOLE-WRITE A CHARACTER ;CALL CWC(N1,N2) ;INPUT - N1 = CHARACTER, RIGHT ADJUSTED ; N2 - NOT USED. CWC: 0 SOSG OB0+2 ;DEC BYTE CT. OUTPUT 0, ;OUTPUT IF NO ROOM MOVEI 1,1 MOVEM 1,@1(Q) ;SET RET - OUTPUT DONE. CWC1: MOVE 1,@(Q) ;FETCH USER DATA IDPB 1,OB0+1 ;STORE IN BUFF. OUTPUT 0, JRA Q,2(Q) ;GENERAL OUTPUT ROUTINE. ;CALLED BY PRT,WDA,PUN. OUTDO: SETZM @1(Q) ;SET NO OUTPUT XCT OSOS(5) ;DEC BYTE CT. JRST PRT1 ;ROOM AVIL. XCT OUT(5) ;NO ROOM, OUTPUT MOVEI 1,1 MOVEM 1,@1(Q) ;SET OUTPUT DONE XCT GET(4) MOVEM 6,STAT XCT STATA(4) ;TEST FOR ERRORS. JRST PRT2 ;ERROR. PRT1: MOVE 1,@(Q) ;GET DATA XCT IDP(5) ;PUT IN BUFF. JRST GSR4 ;EXIT PRT2: MOVEI 1,2 MOVEM 1,@1(Q) ;INDICATE DATA ERROR. JRST PRT1 ;GENERAL INPUT ROUTINE. ;CALLED BY GSR,GDA INDO: SETZM @1(Q) ;NO INPUT DONE. XCT ISOS(5) ;ANY DATA? JRST GSR1 ;YES. XCT IN(5) ;NO, INPUT MOVEI 1,1 MOVEM 1,@1(Q) ;SET INPUT DONE XCT GET(4) MOVEM 6,STAT XCT STATA(4) JRST GSR2 ;DATA ERROR XCT STATB(5) JRST GSR3 ;END OF FILE GSR1: XCT ILD(5) ;GET DATA ANDI 0,377 ;REDUCE TO 8 BITS MOVEM 0,@(Q) GSR4: JRA Q,2(Q) GSR2: SKIPA 1,[3] ;N2=3. EOF SEEN. GSR3: MOVEI 1,2 ;N2=2. DATA ERROR. MOVEM 1,@1(Q) JRST GSR4 ;THE FOLLOWING 5 ROUTINES CALL THE GENERAL ;INPUT (INDO) AND OUTPUT (OUTDO) ROUTINES AFTER ;SETTING THE PROPER INDEX REGISTERS. ; ;CALL PRT(N1,N2) ;CALL WDA(N1,N2) ;CALL PUN(N1,N2) ;INPUT - N1 = CHARACTER TO OUTPUT, RIGHT ADJUSTED ;OUTPUT - N2 = 0 - NO OUTPUT PERFORMED. ; 1 - OUTPUT PERFORMED, NO ERRORS. ; 2 - OUTPUT PERFORMED, DATA ERROR ; ; ;CALL GSR(N1,N2) ;CALL GDA(N1,N2) ;OUTPUT - N1 = CHARACTER READ, RIGHT ADJUSTED ; N2 = 0 - NO INPUT PERFORMED. ; 1 - INPUT PERFORMED, NO ERROR. ; 2 - INPUT PERFORMED, EOF ; 3 - INPUT PERFORMED, DATA ERROR ENTRY PRT ;OUTPUT TO CHANNEL 2 PRT: 0 MOVEI 5,1 MOVEI 4,1 JRST OUTDO ENTRY WDA ;OUTPUT TO CHANNEL 1 WDA: 0 MOVEI 5,0 MOVEI 4,0 JRST OUTDO ENTRY PUN ;OUTPUT TO CHANNEL 4 PUN: 0 MOVEI 5,3 MOVEI 4,3 JRST OUTDO ENTRY GSR ;INPUT FROM CHANNEL 3 GSR: 0 MOVEI 5,2 MOVEI 4,2 JRST INDO ENTRY GDA ;INPUT FROM CHANNEL 1 GDA: 0 MOVEI 5,0 MOVEI 4,0 JRST INDO ;THESE TABLES CONTROL ROUTINES OUTDO AND INDO OSOS: SOSLE OB1+2 SOSLE OB2+2 SOSLE OB3+2 SOSLE OB4+2 ISOS: SOSLE OB1+2 SOSLE OB2+2 SOSLE OB3+2 SOSLE OB4+2 OUT: OUTPUT 1, OUTPUT 2, OUTPUT 3, OUTPUT 4, IN: INPUT 1, INPUT 2, INPUT 3, INPUT 4, GET: GETSTS 1,6 GETSTS 2,6 GETSTS 3,6 GETSTS 4,6 STATA: STATZ 1,740000 STATZ 2,740000 STATZ 3,740000 STATZ 4,740000 STATB: STATZ 1,20000 STATZ 2,20000 STATZ 3,20000 STATZ 4,20000 IDP: IDPB 1,OB1+1 IDPB 1,OB2+1 IDPB 1,OB3+1 IDPB 1,OB4+1 ILD: ILDB 0,OB1+1 ILDB 0,OB2+1 ILDB 0,OB3+1 ILDB 0,OB4+1 ENTRY STATUS ;RETURN THE STATUS REGISTER FROM LAST DEVICE. ;CALL STATUS(N1) ;OUTPUT - N1 = STATUS REGISTER STATUS: 0 MOVE 0,STAT ;RETURN LATEST MOVEM 0,@(Q) ;STATUS. JRA Q,1(Q) ; REENTRY PROCEDURE FOR DETECTING ^C ENTRY SREENT,DREENT EXTERNAL CNTRLC,JOBREN,JOBOPC,NOTYOA SUBTTL REENTRY PROCEDURE ;SET UP REENTER PROCESS WITH FORTRAN -- CALL SREENT SREENT: 0 MOVEI 0,DREENT ;PUT ADDRESS OF REENTER MOVEM 0,JOBREN ;ROUTINE INTO JOBREN SETZM CNTRLC ;CLEAR ^C FLAG. JRA 16,(16) ;EXIT ;DO REENTRY PROCESS DREENT: SETOM CNTRLC ;SET ^C FLAG. JRST 2,@JOBOPC ;RETURN TO PROGRAM ; ;INITIALIZE SINGLE CHARACTER CONSOLE IO ; ;CALL ICRWCS SUBTTL SINGLE CHARACTER IO ENTRY ICRWCS ICRWCS: 0 SKIPE 0,NOTYOA ;IS CHAN 2 BEING USED? OUTPUT 2, ;YES - FORCE AN OUTPUT. OUTPUT 0, ;FORCE OUTPUT TO CONSOLE. MOVEI 0,^D80 MOVEM OBC ;SET OUTPUT BYTE COUNT MOVE 0,[POINT 7,SINB] ;POINTER MOVEM 0,SINPT ;FOR INPUT MOVE 0,[POINT 7,SOTB] ;POINTER MOVEM 0,SOTPT ;FOR OUTPUT SETZM SINB ;CLEAR FIRST INPUT BUF WORD JRA 16,(16) OBC: 0 ;OUTPUT BYTE COUNT SINPT: 0 ;INPUT POINTER SOTPT: 0 ;OUTPUT POINTER SINB: BLOCK 21 ;IN BUF SOTB: BLOCK 21 ;OUT BUF ;READ A SINGLE CHARACTER FROM CONSOLE IN DDT SUBMODE ENTRY CRCS ;CALL CRCS(N1) ;OUTPUT - N1 = CHARACTER, RIGHT ADJUSTED. CRCS: 0 CRCS2: ILDB 0,SINPT ;GET NEXT CHAR JUMPN 0,CRCS1 ;IF NOT NULL, GO EXIT. MOVEI 0,SINB ;NULL, PERFORM CALL 0,[SIXBIT /DDTIN/] ;UNBUFFERED INPUT MOVE 0,[POINT 7,SINB] ;RESET MOVEM 0,SINPT ;BYTE POINTER JRST CRCS2 ;GO START OVER CRCS1: MOVEM 0,@(16) ;SET RETURN VAL JRA 16,1(16) ;EXIT ENTRY CWCS ;WRITE A CHARACTER TO CONSOLE IN DDT SUBMODE. ;CALL CWCS(N1,N2) ;INPUT - N1 = CHARACTER TO PRINT, RIGHT ADJUSTED ;OUTPUT - N2 = 0 - NO OUTPUT DONE, ; 1 - OUTPUT DONE CWCS: 0 SETZM @1(16) ;CLEAR RETURN VALUE. SOSGE OBC ;ROOM IN BUFFER? JRST CWCS1 ;NO - GO OUTPUT CWCS2: MOVE 0,@(16) ;YES - GET CHARACTER. IDPB 0,SOTPT ;PUT IN BUFFER. JUMPE 0,CWCS3 ;IF NULL, GO OUTPUT JRA 16,2(16) ;RETURN CWCS1: SETZ 0, ;TERMINATE BUFFER IDPB 0,SOTPT ;WITH NULL. CWCS3: MOVEI 0,SOTB ;GET BUFF ADR. CALL 0,[SIXBIT/DDTOUT/] ;DO OUTPUT. MOVEI 0,^D80 ;RESET MOVEM 0,OBC ;COUNTER MOVE 0,[POINT 7,SOTB] ;AND POINTER MOVEM 0,SOTPT ; AOS @1(16) ;SET RETURN VAL. MOVE 0,@(16) ;GET CHARACTER TO OUTPUT JUMPN 0,CWCS2+1 ;GO IF NOT NULL. JRA 16,2(16) ENTRY CCK ; ; CHECK FOR INPUT FROM KBD. SET RET=0 IF NONE, ; RET=1 IF SOME. ; OPDEF TTCALL [51B8] OPDEF SKPINL [TTCALL 14,0] CCK: 0 SETZM @(Q) ;SET RETURN VAL. MOVE 0,IB0+2 ;GET CURRENT BUFF BC. SOSG 0 ;ANY DATA LEFT? JRST CCK1 ;NO - TRY NEXT BUFFER IN RING. MOVE 1,IB0+1 ;YES - GET BYTE PTR FOR BUFFER. ILDB 0,1 ;IS NEXT CHAR = 0? JUMPE 0,CCK1 ;YES - TRY NEXT BUFFER. CCK2: AOS @(Q) ;SET RETURN VALUE CCK3: JRA Q,1(Q) CCK1: HRRZ 1,IB0 ;TEST NEXT BUFFER. GET PTR TO CURRENT BUFFER. HRRZ 0,@1 ;GET PTR TO NEXT BUFFER. SKIPGE @0 ;TEST "USE" BIT. IF 0, NO INPUT AVAILABLE. JRST CCK4 ;DATA AVAILABLE. GO CLEAR BC IN CURRENT BUFFER. SKPINL ;DOES THE MONITOR HAVE ANY CHARACTERS? JRST CCK3 ;NO - EXIT CCK4: SETZM IB0+2 ;YES - CLEAR CURRENT BC AND GO EXIT. JRST CCK2 ; ; DUMMY FORSE. KEEPS THE REAL FORSE. FROM LOADING. ; ENTRY FORSE. FORSE.: 0 ;LH=FLAGS, RH=PC CALLI 0 ;RESET ALL IO MOVE 17,PDLST ;SET PUSH LIST JRSTF @FORSE. ;EXIT. LEN=24 PDLST: XWD -LEN,. ;PUSH LIST HEADER BLOCK LEN ENTRY DUMMY. ;THIS DUMMY ROUTINE IS REQUIRED BY THE COMPILER. DUMMY.: 0 HALT ; ; UUO HANDLER -- DOES A RESET ; LOC 41 JSR FORSE. ;CALL DUMMY FORSE. RELOC END