;;; ************************************************************** TITLE ***** MACLISP ****** HUMBLE INFERIOR PACKAGE FOR ITS NEWIO *** ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1977 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** .MLLIT==1 .FASL IF1, .INSRT SYS:.FASL DEFS VERPRT HUMBLE UBPFJ==10 ;FOREIGN JOB REQUIRED BIT FOR USR OPENS TMPC==0 ;TEMP I/O CHANNEL .SXEVAL (SETQ CURRENT-JOB NIL THE-JOB-INPUT-CHANNEL NIL THE-JOB-OUTPUT-CHANNEL NIL THE-JOB-INPUT-CHANNEL-FILE-OBJECT NIL THE-JOB-OUTPUT-CHANNEL-FILE-OBJECT NIL) DEFINE CURJOB .SPECIAL CURRENT-JOB TERMIN DEFINE USRI .SPECIAL THE-JOB-INPUT-CHANNEL TERMIN DEFINE USRO .SPECIAL THE-JOB-OUTPUT-CHANNEL TERMIN DEFINE USRIAR .SPECIAL THE-JOB-INPUT-CHANNEL-FILE-OBJECT TERMIN DEFINE USROAR .SPECIAL THE-JOB-OUTPUT-CHANNEL-FILE-OBJECT TERMIN ;;; (CREATE-JOB ) ;;; CREATES A JOB OBJECT, AND MAKES IT CURRENT. ;;; = NIL (DEFAULT) MEANS YOUR UNAME. ;;; = T (NON-DEFAULT) MEANS REQUIRE FOREIGN JOB. ;;; RETURNS LIST OF TWO THINGS: ;;; (1) ONE OF THE FOLLOWING ATOMS: ;;; INFERIOR ;;; REOWNED ;;; FOREIGN ;;; (2) THE JOB OBJECT ;;; IF WAS NON-NIL AND THE JOB WAS NOT FOUND, NIL IS RETURNED. ;;; (SELECT-JOB ) MAKES THE SPECIFIED JOB CURRENT IN THE ;;; EXPECTED MODE (FOREIGN OR NOT), RETURNING VALUES AS FOR CREATE-JOB. HACKJ0: WTA [BAD JOB OBJECT - SELECT-JOB!] .ENTRY SELECT-JOB SUBR 0002 ;SUBR 1 PUSHJ P,JOBP JRST HACKJ0 JSP T,NPUSH-5 MOVEI TT,J.INTB SKIPN @TTSAR(A) HLLOS (P) HLLOS NOQUIT MOVEI TT,J.CINT MOVE B,@TTSAR(A) MOVE TT,TTSAR(A) JRST CRJOB5 .ENTRY CREATE-JOB LSUBR 004006 ;LSUBR (3 . 5) JSP TT,LWNACK LA345,,.ATOM CREATE-JOB ;LA345 MEANS 3-5 ARGS. CAML T,[-4] PUSH P,[NIL] CAML T,[-3] PUSH P,[NIL] SKIPN A,-1(P) TDZA TT,TT PUSHJ P,SIXMAK PUSH FXP,TT MOVE A,-2(P) PUSHJ P,SIXMAK PUSH FXP,TT PUSH FXP,[-1] HLLOS NOQUIT .CALL [ SETZ SIXBIT \OPEN\ ;OPEN FILE (JOB) 5000,,UBPFJ+6 ;INSIST ALREADY EXIST, PLUS IMAGE BLOCK INPUT 1000,,TMPC ;CHANNEL NUMBER ,,[SIXBIT \USR\] ;DEVICE NAME ,,-2(FXP) ;UNAME 400000,,-1(FXP) ] ;JNAME SETZM (FXP) .CLOSE TMPC, HLLZS NOQUIT PUSHJ P,CHECKI SKIPN (FXP) SKIPN (P) CAIA JRST CRJOB8 ;RETURN NIL IF LOSE PUSHJ P,GTJCHN ;GET JOB CHANNELS PUSH P,[CRJOB2] PUSH P,[NIL] PUSH P,[.ATOM FIXNUM ] PUSH P,[.ATOM #LOJOBA ] MOVNI T,3 JCALL 16,.FUNCTION *ARRAY CRJOB2: HLLOS NOQUIT MOVE TT,TTSAR(A) POP FXP,F POP FXP,F.FN2(TT) POP FXP,T SKIPN T .SUSET [.RUNAME,,T] MOVEM T,F.FN1(TT) MOVSI T,(SIXBIT \USR\) MOVEM T,F.DEV(TT) MOVSI D,AS IORB D,ASAR(A) MOVSI T,-J.GC HLLM T,-1(D) MOVE B,-4(P) MOVEM B,J.INTF(TT) MOVE B,-3(P) MOVEM B,J.CINT(TT) CRJOB5: MOVEM A,CURJOB ;SELECT-JOB JOINS HERE MOVE C,USRIAR MOVE T,TTSAR(C) MOVEM B,FJ.INT(T) MOVE C,USROAR MOVE T,TTSAR(C) MOVEM B,FJ.INT(T) SKIPN (P) TDZA T,T MOVEI T,UBPFJ .CALL [ SETZ SIXBIT \OPEN\ ;OPEN FILE (JOB) 5000,,6(T) ;IMAGE BLOCK INPUT MODE ,,@USRI ;CHANNEL NUMBER ,,F.DEV(TT) ;DEVICE NAME (USR) ,,F.FN1(TT) ;UNAME 400000,,F.FN2(TT) ] ;JNAME JRST CRJOB7 .CALL [SETZ SIXBIT \USRVAR\ ,,@USRI 1000,,.ROPTION 1000,,0 ;IGNORED FOR IMMEDIATE-INST MODE SETZ [TLO %OPLSP]] ;TURN ON "LISP IS SUPERIOR" BIT JFCL ;IGNORE FAILURE, MIGHT NOT BE OUR JOB ;; Don't put these .calls together, the OPTION is allowed to ;; fail, but the uind shouldn't. .CALL [SETZ ? SIXBIT \USRVAR\ ,,@USRI 1000,,.RUIND SETZM J.UIND(TT)] .LOSE %LSFIL ; ??? MOVE T,@USRI ;PICK UP CHANNEL NUMBER MOVEM T,F.CHAN(TT) ;FORCE IT TO BE CHAN # OF JOB ARRAY .CALL [ SETZ SIXBIT \RCHST\ ;READ CHANNEL STATUS ,,@USRI ;CHANNEL NUMBER OF JOB 2000,,F.RDEV(TT) ;DEVICE NAME 2000,,F.RFN1(TT) ;FILE NAME 1 2000,,F.RFN2(TT) ;FILE NAME 2 2000,,R ;SNAME (ZERO) (IGNORE) 2000,,R ;ACCESS POINTER (ZERO) (IGNORE) 402000,,R ] ;MODE BITS (1.4 => FOREIGN JOB) .VALUE SETZM J.INTB(TT) MOVEI B,.ATOM FOREIGN TRNE R,UBPFJ JRST CRJOB4 MOVE D,@USRI LSH D,27 IOR D,[.USET 0,[.RINTB,,T]] XCT D MOVEM T,J.INTB(TT) .CALL [ SETZ SIXBIT \OPEN\ ;OPEN JOB 5000,,7 ;IMAGE BLOCK OUTPUT ,,@USRO ;CHANNEL NUMBER ,,F.DEV(TT) ;DEVICE NAME (USR) ,,F.FN1(TT) ;UNAME 400000,,F.FN2(TT) ] ;JNAME .VALUE .CALL [ SETZ SIXBIT \RCHST\ ;READ CHANNEL STATUS ,,@USRO ;CHANNEL NUMBER OF JOB 2000,,F.RDEV(TT) ;DEVICE NAME 2000,,F.RFN1(TT) ;FILE NAME 1 402000,,F.RFN2(TT) ] ;FILE NAME 2 .VALUE JFFO T,.+1 MOVNS TT MOVEM A,JOBTB+21(TT) MOVEI B,.ATOM INFERIOR SKIPE F MOVEI B,.ATOM REOWNED CRJOB4: HLLZS NOQUIT PUSHJ P,CHECKI PUSH P,B CALL 1,.FUNCTION NCONS POP P,B CALL 2,.FUNCTION XCONS CRJOB9: SUB P,[5,,5] POPJ P, CRJOB7: HLLZS NOQUIT PUSHJ P,CHECKI CRJB7A: SETZB A,CURJOB JRST CRJOB9 CRJOB8: SUB FXP,[3,,3] JRST CRJB7A GTJCH0: SUB P,[1,,1] MOVEI A,.SX (?) IOL [NOT ENOUGH I/O CHANNELS!] GTJCHN: SKIPE USRIAR POPJ P, PUSH P,[NIL] MOVSI TT,(SIXBIT \USR\) PUSHJ P,ALFILE JRST GTJCH0 MOVEM A,(P) MOVSI TT,(SIXBIT \USR\) PUSHJ P,ALFILE JRST GTJCH0 MOVEI AR1,(A) POP P,AR2A MOVSI TT,TTS ;THIS ONE IS OUTPUT IORM TT,TTSAR(AR2A) MOVEI TT,F.CHAN MOVE F,@TTSAR(AR1) MOVE TT,@TTSAR(AR2A) JSP T,FXCONS MOVEI B,(A) MOVE TT,F JSP T,FXCONS HLLOS NOQUIT MOVE T,TTSAR(AR1) MOVE TT,TTSAR(AR2A) MOVE D,[SIXBIT \ USRI \] MOVEM D,F.FN1(T) MOVEM D,F.RFN1(T) MOVE D,[SIXBIT \ USRO \] MOVEM D,F.FN1(TT) MOVEM D,F.RFN1(TT) MOVE D,[SIXBIT \ CHNL \] MOVEM D,F.FN2(T) MOVEM D,F.FN2(TT) MOVEM D,F.RFN2(T) MOVEM D,F.RFN2(TT) MOVEM A,USRI MOVEM B,USRO MOVEM AR1,USRIAR MOVEM AR2A,USROAR HLLZS NOQUIT JRST CHECKI DEFINE JOBLOK FN ;LOCK USER INTS, CHECK OUT CURRENT-JOB LOCKI SKIPN A,CURJOB JRST UNLKNIL PUSHJ P,JOBP JRST [ SETZM CURJOB UNLOCKI FAC [CURRENT-JOB CONTAINED BAD JOB OBJECT - FN!!] ] TERMIN DEFINE INFLOK FN ;INSIST ON INFERIOR JOBLOK FN MOVE T,TTSAR(A) SKIPN T,J.INTB(T) JRST UNLKNIL TERMIN ;;; (JOB-USET-READ ) RETURNS VALUE OF USET VAR , ;;; OR NIL IF NO CURRENT JOB. .ENTRY JOB-USET-READ SUBR 0002 ;SUBR 1 JSP T,FXNV1 JOBLOK JOB-USET-READ MOVE D,@USRI LSH D,27 IOR D,[.USET 0,T] HRLI T,(TT) HRRI T,TT XCT D UNLOCKI JRST FIX1 ;;; (JOB-USET-WRITE ) WRITES USET VAR , ;;; OR NIL IF NO CURRENT JOB OR FOREIGN JOB. ;;; SHOULD HAVE THE 400000 BIT SET. .ENTRY JOB-USET-WRITE SUBR 0003 ;SUBR 2 JSP T,FXNV1 JSP T,FXNV2 INFLOK JOB-USET-WRITE MOVE R,@USRI LSH R,27 IOR R,[.USET 0,T] HRLI T,(TT) HRRI T,D XCT R UNLOCKI MOVEI A,.ATOM T POPJ P, ;;; (KILL-JOB) KILLS THE CURRENT JOB. .ENTRY KILL-JOB SUBR 0001 ;SUBR 0 JOBLOK KILL-JOB HLLOS NOQUIT SETZM CURJOB MOVE TT,TTSAR(A) TLNE TT,TTS ;IN CASE OF ASYNCHRONOUS LOSSES JRST KILLJ9 MOVSI T,TTS IORM T,TTSAR(A) SKIPN T,J.INTB(TT) JRST KILLJ2 JFFO T,.+1 MOVNS TT SETZM JOBTB+21(TT) MOVE T,@USRI LSH T,27 IOR T,[.UCLOSE 0,] XCT T JRST KILLJ8 KILLJ2: .CALL [ SETZ SIXBIT \CLOSE\ ;CLOSE CHANNEL 400000,,@USRI ] ;CHANNEL NUMBER .VALUE .CALL [ SETZ SIXBIT \CLOSE\ ;CLOSE CHANNEL 400000,,@USRO ] ;CHANNEL NUMBER .VALUE KILLJ8: MOVEI A,.ATOM T KILJ8A: HLLZS NOQUIT UNLKPOPJ KILLJ9: MOVEI A,NIL JRST KILJ8A ;;; SKIPS IF VALID JOB OBJECT IN A. ;;; USES ONLY A, B, T. JOBP: MOVEI B,(A) CALL 1,.FUNCTION TYPEP EXCH A,B CAIE B,.ATOM ARRAY POPJ P, MOVE T,ASAR(A) TLNN T,AS POPJ P, MOVE T,TTSAR(A) TLNN T,TTS AOS (P) POPJ P, ;;; (LOAD-JOB ) OPENS UP FILE ;;; AND LOADS IT INTO THE CURRENT JOB. ;;; RETURNS: ;;; NIL WON! ;;; BIN? FILE NOT BIN ;;; FILE? FILE NOT FOUND .ENTRY LOAD-JOB SUBR 0002 ;SUBR 1 MOVEI C,(A) INFLOK LOAD-JOB MOVEI A,(C) CALL 2,.FUNCTION MERGEF PUSHJ P,FIL6BT HLLOS NOQUIT MOVEI A,.ATOM FILE? .CALL [ SETZ SIXBIT \OPEN\ ;OPEN FILE 5000,,6 ;IMAGE BLOCK INPUT 1000,,TMPC ;CHANNEL NUMBER ,,-3(FXP) ;DEVICE ,,-1(FXP) ;FILE NAME 1 ,,0(FXP) ;FILE NAME 2 400000,,-2(FXP) ] ;SNAME JRST LDJB9 .CALL [ SETZ SIXBIT \RESET\ ;RESET THE JOB 400000,,@USRI ] ;CHANNEL NUMBER .VALUE MOVEI A,.ATOM BIN? .CALL [ SETZ SIXBIT \LOAD\ ;LOAD JOB ,,@USRO ;JOB SPEC 400000,,TMPC ] ;DISK CHANNEL JRST LDJB9 HRROI T,TT .IOT TMPC,T .CLOSE TMPC, HRRZ C,CURJOB MOVE T,TTSAR(C) MOVEM TT,J.STAD(T) MOVEI A,NIL LDJB9: SUB FXP,[4,,4] HLLZS NOQUIT UNLKPOPJ ;;; (EXAMINE-JOB ) EXAMINES LOCATION OF CURRENT JOB. ;;; RETURNS NIL ON FAILURE (INDICATES BAD ERROR). .ENTRY EXAMINE-JOB SUBR 0002 ;SUBR 1 NCALLABLE PUSH P,[FIX1] JSP T,FXNV1 JOBLOK EXAMINE-JOB JSP F,JOBED @USRI JRST UNLKNIL MOVE TT,D UNLOCKI POPJ P, ;;; (DEPOSIT-JOB ) DEPOSITS IN OF CURRENT JOB. ;;; RETURNS NIL ON FAILURE (INDICATES BAD ERROR). .ENTRY DEPOSIT-JOB SUBR 0003 ;SUBR 2 JSP T,FXNV1 JSP T,FXNV2 INFLOK DEPOSIT-JOB JSP F,JOBED @USRO UNLKNIL: TDZA A,A UNLKT: MOVEI A,.ATOM T UNLKPOPJ JOBED: MOVEI A,NIL .CALL [ SETZ SIXBIT \ACCESS\ ;SET ACCESS POINTER ,,@(F) ;CHANNEL NUMBER 400000,,TT ] ;NEW ACCESS POINTER JRST 1(F) HRROI TT,D .CALL [ SETZ SIXBIT \IOT\ ;IOT ,,@(F) ;CHANNEL NUMBER 400000,,TT ] ;IOT POINTER JRST 1(F) JRST 2(F) ;;; (*ATTY) DOES A .ATTY TO THE CURRENT JOB. .ENTRY *ATTY SUBR 0001 ;SUBR 0 INFLOK *ATTY MOVE TT,TTSAR(A) SKIPN J.INTB(TT) JRST UNLKNIL MOVE D,@USRI LSH D,27 IOR D,[.ATTY 0,] XCT D JRST UNLKNIL JRST UNLKT ;;; (*DTTY) DOES A .DTTY. .ENTRY *DTTY SUBR 0001 ;SUBR 0 .DTTY TDZA A,A MOVEI A,.ATOM T POPJ P, FASEND