mirror of
https://github.com/PDP-10/its.git
synced 2026-01-27 12:42:10 +00:00
Added lots of new LSPLIB packages (and their sources).
This commit is contained in:
Eric Swenson
1214
src/l/defns.240
Executable file
1214
src/l/defns.240
Executable file
File diff suppressed because it is too large
Load Diff
474
src/l/humble.42
Executable file
474
src/l/humble.42
Executable file
@@ -0,0 +1,474 @@
|
||||
|
||||
;;; **************************************************************
|
||||
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 <JOBINTFUN> <CHNINTFUN> <JNAME> <UNAME> <FOREIGN>)
|
||||
;;; CREATES A JOB OBJECT, AND MAKES IT CURRENT.
|
||||
;;; <UNAME> = NIL (DEFAULT) MEANS YOUR UNAME.
|
||||
;;; <FOREIGN> = 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 <FOREIGN> WAS NON-NIL AND THE JOB WAS NOT FOUND, NIL IS RETURNED.
|
||||
|
||||
;;; (SELECT-JOB <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<JOB>
|
||||
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<IO> ;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 <NUM>) RETURNS VALUE OF USET VAR <NUM>,
|
||||
;;; 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 <NUM> <VAL>) WRITES USET VAR <NUM>,
|
||||
;;; OR NIL IF NO CURRENT JOB OR FOREIGN JOB.
|
||||
;;; <NUM> 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<CL> ;IN CASE OF ASYNCHRONOUS LOSSES
|
||||
JRST KILLJ9
|
||||
MOVSI T,TTS<CL>
|
||||
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<JOB>
|
||||
POPJ P,
|
||||
MOVE T,TTSAR(A)
|
||||
TLNN T,TTS<CL>
|
||||
AOS (P)
|
||||
POPJ P,
|
||||
|
||||
;;; (LOAD-JOB <FILENAME>) OPENS UP FILE <FILENAME>
|
||||
;;; 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 <LOC>) EXAMINES LOCATION <LOC> 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 <LOC> <VAL>) DEPOSITS <VAL> IN <LOC> 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
|
||||
Reference in New Issue
Block a user