mirror of
https://github.com/PDP-10/its.git
synced 2026-03-20 08:28:43 +00:00
cc8e6c1964
the lisp interpreter is first booted. Redumps lisp compiler with updated FASL files built from source.
468 lines
11 KiB
Groff
Executable File
468 lines
11 KiB
Groff
Executable File
|
||
;;; BLTARR -*-MIDAS-*-
|
||
;;; **************************************************************
|
||
;;; ***** MACLISP ****** BLTARRAY ********************************
|
||
;;; **************************************************************
|
||
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
|
||
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
|
||
;;; **************************************************************
|
||
|
||
.SYMTAB 16001. ;1863.rd prime
|
||
TITLE ***** MACLISP ****** BLTARRAY ********************************
|
||
|
||
|
||
;; To assemble on one kind of Operating system, for use on another,
|
||
;; you should use the "T" command line switch in order to insert one
|
||
;; of the redefinitions:
|
||
;; D10==1
|
||
;; D20==1
|
||
;; ITS==1
|
||
;; SAIL==1
|
||
|
||
|
||
.FASL
|
||
|
||
IF1,[
|
||
|
||
|
||
IFNDEF TOPS10, TOPS10==0
|
||
IFNDEF TOPS20, TOPS20==0
|
||
IFNDEF TENEX, TENEX==0
|
||
IFNDEF CMU, CMU==0
|
||
|
||
IFN TOPS10\CMU, D10==1
|
||
IFN TOPS20\TENEX, D20==1
|
||
|
||
IFE .OSMIDAS-<SIXBIT \ITS\>,[
|
||
IFNDEF D20, D20==0
|
||
IFNDEF D10, D10==0
|
||
IFNDEF SAIL SAIL==0
|
||
IFNDEF ITS,[
|
||
IFE D10+D20+SAIL, ITS==1
|
||
.ELSE ITS==0
|
||
]
|
||
DEFINE $INSRT $%$%$%
|
||
.INSRT $%$%$% >
|
||
PRINTX \ ==> INSERTED: \
|
||
$FNAME .IFNM1
|
||
PRINTX \ \
|
||
$FNAME .IFNM2
|
||
PRINTX \
|
||
\
|
||
TERMIN
|
||
] ;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
|
||
|
||
|
||
IFE .OSMIDAS-<SIXBIT \DEC\>,[
|
||
IFNDEF ITS, ITS==0
|
||
IFNDEF D20, D20==0
|
||
IFNDEF SAIL SAIL==0
|
||
IFNDEF D10,[
|
||
IFE ITS+D20+SAIL, D10==1
|
||
.ELSE D10==0
|
||
]
|
||
DEFINE $INSRT $%$%$%
|
||
.INSRT $%$%$%!.MID
|
||
PRINTX \INSERTED: \
|
||
$FNAME .IFNM1
|
||
PRINTX \.\
|
||
$FNAME .IFNM2
|
||
PRINTX \
|
||
\
|
||
TERMIN
|
||
] ;END OF IFE .OSMIDAS-<SIXBIT \DEC\>,
|
||
|
||
IFE .OSMIDAS-<SIXBIT \TWENEX\>,[
|
||
IFNDEF ITS, ITS==0
|
||
IFNDEF D10, D10==0
|
||
IFNDEF SAIL SAIL==0
|
||
IFNDEF D20,[
|
||
IFE ITS+D10+SAIL, D20==1
|
||
.ELSE D20==0
|
||
]
|
||
DEFINE $INSRT $%$%$%
|
||
.INSRT $%$%$%!.MID
|
||
PRINTX \INSERTED: \
|
||
$FNAME .IFNM1
|
||
PRINTX \.\
|
||
$FNAME .IFNM2
|
||
PRINTX \
|
||
\
|
||
TERMIN
|
||
] ;END OF IFE .OSMIDAS-<SIXBIT \TWENEX\>,
|
||
|
||
|
||
IFE .OSMIDAS-<SIXBIT \SAIL\>,[
|
||
IFNDEF ITS, ITS==0
|
||
IFNDEF D10, D10==0
|
||
IFNDEF D20, D20==0
|
||
IFNDEF SAIL,[
|
||
IFE ITS+D10+D20, SAIL==1
|
||
.ELSE SAIL==0
|
||
]
|
||
DEFINE $INSRT $%$%$%
|
||
.INSRT $%$%$%!.MID
|
||
PRINTX \INSERTED: \
|
||
$FNAME .IFNM1
|
||
PRINTX \.\
|
||
$FNAME .IFNM2
|
||
PRINTX \
|
||
\
|
||
TERMIN
|
||
] ;END OF IFE .OSMIDAS-<SIXBIT \SAIL\>,
|
||
|
||
|
||
IFNDEF $INSRT, .FATAL SO WHAT KIND OF OPERATING SYSTEM IS THIS ANYWAY???
|
||
|
||
DEFINE $FNAME FOO ;PRINTX A FILE NAME GIVEN NUMERIC SIXBIT
|
||
ZZX==<FOO>
|
||
REPEAT 6,[
|
||
IRPNC ZZX_-36,1,1,Q,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)^_]
|
||
IFSN [Q][ ] PRINTX |Q|
|
||
TERMIN
|
||
ZZX==ZZX_6
|
||
]
|
||
TERMIN
|
||
|
||
IFN ITS+D10+D20+SAIL-1,[
|
||
INFORM [
|
||
ITS=]\ITS,[ D10=]\D10,[ D20=]\D20,[ SAIL=]\SAIL
|
||
.FATAL ITS, D10, D20, and SAIL switches are not consistent
|
||
] ;END OF IFN ITS+D10+D20+SAIL-1
|
||
|
||
|
||
D10==:TOPS10\CMU ;SWITCH FOR DEC-10-LIKE SYSTEMS
|
||
D20==:TOPS20\TENEX ;SWITCH FOR DEC-20-LIKE SYSTEMS
|
||
|
||
|
||
IFN D10,[
|
||
PRINTX \ASSEMBLING DEC-10 BLTARRAY
|
||
\
|
||
]
|
||
IFN D20,[
|
||
PRINTX \ASSEMBLING DEC-20 BLTARRAY
|
||
\
|
||
]
|
||
|
||
IFN ITS,[
|
||
PRINTX \ASSEMBLING ITS BLTARRAY
|
||
\
|
||
]
|
||
|
||
IFN SAIL, D10==1
|
||
|
||
|
||
$INSRT FASDFS
|
||
|
||
|
||
|
||
|
||
|
||
|
||
;;; MAKE SURE THE SYMBOLS WE WILL NEED ARE DEFINED.
|
||
;;; THEY MAY NOT BE IF ASSEMBLING FOR A DIFFERENT OPERATING SYSTEM
|
||
|
||
DEFINE FLUSHER DEF/
|
||
IRPS SYM,,[DEF]
|
||
EXPUNGE SYM
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
DEFINE SYMFLS TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
|
||
IFE <.OSMIDAS-SIXBIT\OS\>,[
|
||
IFE TARGETSYS,[
|
||
PRINTX \FLUSHING OS SYMBOL DEFINITIONS
|
||
\
|
||
$INSRT .DEFS.
|
||
DEFFER FLUSHER
|
||
IFSN .BITS.,,[
|
||
PRINTX \FLUSHING OS BIT DEFINITIONS
|
||
\
|
||
EQUALS DEFSYM,FLUSHER
|
||
$INSRT .BITS.
|
||
EXPUNGE DEFSYM
|
||
] ;END OF IFSN .BITS.
|
||
] ;END OF IFE TARGETSYS
|
||
] ;END OF IFE <.OSMIDAS-SIXBIT\OS\>
|
||
TERMIN
|
||
|
||
DEFINE SYMDEF TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
|
||
IFN TARGETSYS,[
|
||
IFN <.OSMIDAS-SIXBIT\OS\>,[
|
||
PRINTX \MAKING OS SYMBOL DEFINITIONS
|
||
\
|
||
$INSRT .DEFS.
|
||
DEFFER
|
||
IFSN .BITS.,,[
|
||
PRINTX \MAKING OS BIT DEFINITIONS
|
||
\
|
||
$INSRT .BITS.
|
||
] ;END OF IFSN .BITS.,,
|
||
] ;END OF IFN <.OSMIDAS-SIXBIT\OS\>
|
||
.ELSE,[
|
||
IFNDEF CHKSYM,[
|
||
PRINTX \FUNNY - RUNNING ON OS, BUT CHKSYM UNDEFINED; MAKING OS SYMBOL DEFINITIONS
|
||
\
|
||
$INSRT .DEFS.
|
||
DEFFER
|
||
] ;END OF IFNDEF CHKSYM
|
||
IFSN .BITS.,,[
|
||
IFNDEF CHKBIT,[
|
||
PRINTX \FUNNY - RUNNING ON OS, BUT CHKBIT UNDEFINED; MAKING OS BIT DEFINITIONS
|
||
\
|
||
$INSRT .BITS.
|
||
] ;END OF IFNDEF CHKBIT
|
||
] ;END OF IFSN .BITS.,,
|
||
] ;END OF .ELSE
|
||
] ;END OF IFN TARGETSYS
|
||
TERMIN
|
||
|
||
|
||
|
||
IRP HACK,,[SYMFLS,SYMDEF]
|
||
HACK ITS,ITS,ITSDFS,.ITSDF,.IOT,ITSBTS,%PIC.Z
|
||
HACK TOPS10,DEC,DECDFS,.DECDF,LOOKUP,DECBTS,.GTSTS
|
||
HACK TOPS20,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
|
||
HACK TENEX,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
|
||
HACK SAIL,SAIL,SAIDFS,.DECDF,SPCWAR,DECBTS,.GTSTS
|
||
TERMIN
|
||
|
||
|
||
] ;END OF IF1
|
||
|
||
VERPRT BLTARRAY
|
||
|
||
|
||
|
||
|
||
.ENTRY BLTARRAY SUBR 3 ;2 ARGS
|
||
EXCH A,B ;GRUMBLE! CALLED BY FILLARRAY
|
||
SOVE B C AR1 AR2A
|
||
PUSHJ P,AREGET
|
||
MOVEI AR1,(A)
|
||
HRRZ A,-3(P)
|
||
BLTAR1: PUSHJ P,AREGET
|
||
MOVEI AR2A,(A)
|
||
MOVE T,ASAR(AR1)
|
||
MOVE TT,ASAR(AR2A)
|
||
;; NEXT FEW LINES SHOULD BE CONDITIONAL ON HAVING JOBQIO
|
||
TLNE T,AS.JOB
|
||
JRST BLTALS
|
||
TLNE TT,AS.JOB
|
||
JRST BLTALZ
|
||
|
||
TLNE T,AS.FIL
|
||
JRST BLTI1
|
||
TLNE TT,AS.FIL
|
||
JRST BLTO1
|
||
LOCKI
|
||
PUSHJ P,.REA3
|
||
JRST BLTALZ ;ARRAY TYPES DON'T MATCH - LOSE LOSE
|
||
BLTXIT: RSTR AR2A AR1 C
|
||
UNLOCKI
|
||
JRST POPAJ
|
||
|
||
BLTALZ: UNLOCKI
|
||
MOVEI A,(AR2A)
|
||
WTA [BAD TARGET ARRAY TYPE - BLTARRAY!]
|
||
MOVEI AR2A,(A)
|
||
JRST BLTAR1
|
||
|
||
BLTALS: UNLOCKI
|
||
MOVEI A,(AR1)
|
||
WTA [BAD SOURCE ARRAY TYPE - BLTARRAY!]
|
||
MOVEI AR1,(A)
|
||
JRST BLTAR1
|
||
|
||
|
||
;FILL OUTPUT FILE IN AR2A FROM ARRAY IN AR1.
|
||
|
||
BLTO1: TLNE T,AS.FIL+AS.RDT+AS.OBA+AS.GCP ;FILES, READTABLES, OBARRAYS, S-EXPS BAD
|
||
JRST BLTALS
|
||
EXCH AR1,AR2A
|
||
PUSHJ P,XOFLOK ;MAKE SURE TARGET ARRAY IS BINARY OUTPUT
|
||
IFN ITS,[
|
||
PUSHJ P,IFORCE ;FORCE OUT CURRENT BUFFER, IF ANY
|
||
MOVEI A,(AR2A)
|
||
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
|
||
MOVE D,TT ;MOVE INTO D
|
||
HRRZ T,TTSAR(AR2A)
|
||
HRLI T,444400 ;SET UP BYTE POINTER (BYTE = 36. BITS)
|
||
MOVE TT,TTSAR(AR1)
|
||
ADDM D,F.FPOS(TT)
|
||
.CALL BSIOT ;TRANSFER DATA TO FILE
|
||
.LOSE 1400
|
||
JSP D,BFORC6 ;UPDATE FILE OBJECT VARIABLES
|
||
] ;END OF IFN ITS
|
||
IFN D20,[
|
||
PUSHJ P,IFORCE ;FORCE OUT CURRENT BUFFER, IF ANY
|
||
MOVEI A,(AR2A)
|
||
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
|
||
HRRZ 2,TTSAR(AR2A)
|
||
HRLI 2,444400 ;SET UP BYTE POINTER (BYTE = 36. BITS)
|
||
MOVN 3,TT ;NEGATIVE OF NUMBER OF BYTES
|
||
MOVE D,TT
|
||
MOVE TT,TTSAR(AR1)
|
||
HRRZ 1,F.JFN(TT) ;GET JFN FOR FILE
|
||
ADDM D,F.FPOS(TT)
|
||
SOUT ;TRANSFER DATA TO FILE
|
||
SETZB 2,3 ;FLUSH CRUD FROM AC'S
|
||
JSP D,BFORC6 ;UPDATE FILE OBJECT VARIABLES
|
||
] ;END OF IFN D20
|
||
IFN D10,[
|
||
MOVEI A,(AR2A)
|
||
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
|
||
MOVE T,TTSAR(AR2A)
|
||
MOVE F,TTSAR(AR1)
|
||
MOVE B,F.CHAN(F) ;GET CHANNEL NUMBER FOR I/O FILE
|
||
LSH B,27
|
||
TLO B,(OUT 0,) ;CONSTRUCT AN OUT INSTRUCTION
|
||
MOVE A,FB.HED(F) ;GET ADDRESS OF BUFFER HEADER BLOCK
|
||
BLTO3: MOVE D,1(A) ;GET BYTE POINTER INTO BUFFER
|
||
ADDI D,1 ;ADDRESS OF FIRST FREE WORD IN BUFFER
|
||
HRLI D,(T) ;ADDRESS OF NEXT DATA WORD TO TRANSFER
|
||
SKIPN R,2(A) ;GET COUNT OF FREE BUFFER WORDS IN R
|
||
JRST BLTO4 ;OOPS, NONE - GO OUTPUT THIS BUFFER
|
||
CAILE R,(TT) ;IF REST OF DATA FITS IN BUFFER,
|
||
MOVEI R,(TT) ; TRANSFER NO MORE THAN NECESSARY
|
||
SUB TT,2(A) ;SUBTRACT FREE WORDS IN BUFFER FROM COUNT OF REMAINING DATA
|
||
MOVNS R
|
||
ADDM R,2(A) ;ADJUST BUFFER FREE COUNT FOR WORDS TRANSFERRED
|
||
MOVNS R
|
||
ADDB R,1(A) ;ADJUST BYTE POINTER, GET FINAL ADDRESS
|
||
BLT D,(R)
|
||
JUMPL TT,BLTXIT ;DIDN'T COMPLETELY FILL THIS LAST BUFFER, SO EXIT
|
||
BLTO4: XCT B ;OUTPUT THIS BUFFER
|
||
CAIA
|
||
HALT ;? THE OUTPUT LOST SOMEHOW
|
||
MOVE D,FB.BFL(F)
|
||
ADDM D,F.FPOS(F) ;UPDATE FILEPOS
|
||
JUMPG TT,BLTO3 ;GO AROUND AGAIN IF MORE DATA LEFT
|
||
] ;END OF IFN D10
|
||
JRST BLTXIT
|
||
|
||
IFN ITS+D20,[
|
||
BFORC6: MOVE T,FB.BFL(TT) ;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT
|
||
MOVEM T,FB.CNT(TT)
|
||
MOVE T,FB.IBP(TT)
|
||
MOVEM T,FB.BP(TT)
|
||
JRST (D)
|
||
];END IFN ITS+D20
|
||
|
||
|
||
|
||
|
||
;FILL ARRAY IN AR2A FROM FILE IN AR1.
|
||
|
||
BLTI1: TLNE TT,AS.FIL+AS.RDT+AS.OBA+AS.GCP ;FILES, READTABLES, OBARRAYS, S-EXPS BAD
|
||
JRST BLTALZ
|
||
PUSHJ P,XIFLOK ;MAKE SURE SOURCE IS AN INPUT BINARY FILE
|
||
IFN ITS+D20,[
|
||
MOVEI A,(AR2A)
|
||
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
|
||
MOVE T,TTSAR(AR2A)
|
||
MOVE F,TTSAR(AR1)
|
||
SKIPN R,FB.CNT(F) ;GET NUMBER OF DATA WORDS IN INPUT BUFFER
|
||
JRST BLTI4 ;NONE, GO DO DIRECT INPUT
|
||
CAILE R,(TT) ;TRANSFER NO MORE WORDS THAN
|
||
MOVEI R,(TT) ; THE TARGET ARRAY WILL HOLD
|
||
SUBI TT,(R) ;ADJUST COUNT FOR NUMBER OF WORDS TRANSFERRED
|
||
MOVN D,R
|
||
ADDM D,FB.CNT(F) ;ADJUST BYTE COUNT IN FILE OBJECT
|
||
IBP FB.BP(F) ;BYTE POINTER TO POINT TO FIRST BYTE WE WANT
|
||
MOVE D,FB.BP(F)
|
||
HRLI D,(D) ;ADDRESS OF FIRST WORD OF INPUT DATA
|
||
HRRI D,(T)
|
||
ADDI T,(R) ;UPDATE POINTER INTO TARGET ARRAY
|
||
SUBI R,1 ;FOR CORRECT UPDATING, R IS 1 TOO BIG
|
||
ADDM R,FB.BP(F) ;UPDATE FILE BYTE POINTER
|
||
BLT D,-1(T) ;TRANSFER DATA
|
||
JUMPLE TT,BLTXIT ;EXIT IF WE GOT ENOUGH DATA
|
||
MOVE D,FB.BVC(F)
|
||
ADDM D,F.FPOS(F)
|
||
SETZM FB.BVC(F)
|
||
BLTI4:
|
||
IFN ITS,[
|
||
MOVE R,TT
|
||
MOVE D,TT ;GET COUNT OF BYTES
|
||
MOVE TT,F
|
||
HRLI T,444400 ;MAKE BYTE POINTER (BYTE = 36. BITS)
|
||
.CALL BSIOT ;INPUT MORE DATA
|
||
.LOSE 1400
|
||
SUB R,D
|
||
ADDM R,F.FPOS(TT) ;UPDATE THE FILE POSITION
|
||
JUMPE D,BLTXIT ;JUMP IF WE GOT ALL THE DATA
|
||
] ;END OF IFN ITS
|
||
IFN D20,[
|
||
HRRZ 1,F.JFN(F) ;GET JFN FOR FILE
|
||
MOVEI 2,(T)
|
||
HRLI 2,444400 ;MAKE BYTE POINTER (BYTE = 36. BITS)
|
||
MOVN 3,TT
|
||
SIN ;INPUT MORE DATA
|
||
ADD TT,3 ;NOT ADDI!!!
|
||
ADDM TT,F.FPOS(F) ;UPDATE THE FILE POSITION
|
||
MOVE D,3
|
||
SETZB 2,3 ;FLUSH JUNK FROM AC'S
|
||
JUMPE D,BLTXIT ;JUMP IF WE GOT ALL THE DATA
|
||
] ;END OF IFN D20
|
||
] ;END OF IFN ITS+D20
|
||
IFN D10,[
|
||
MOVEI A,(AR2A)
|
||
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
|
||
MOVE T,TTSAR(AR2A)
|
||
MOVE F,TTSAR(AR1)
|
||
MOVE B,F.CHAN(F) ;GET CHANNEL NUMBER FOR FILE
|
||
LSH B,27
|
||
TLO B,(IN 0,) ;CONSTRUCT AN IN INSTRUCTION
|
||
MOVE A,FB.HED(F) ;GET ADDRESS OF BUFFER HEADER BLOCK
|
||
BLTI3: SKIPN R,2(A) ;CHECK NUMBER OF WORDS IN THIS BUFFER
|
||
JRST BLTI5 ;NONE - GO READ SOME MORE
|
||
CAILE R,(TT) ;DON'T TRANSFER MORE WORDS
|
||
MOVEI R,(TT) ; THAN THE TARGET ARRAY NEEDS
|
||
SUBI TT,(R) ;ADJUST COUNT OF WORDS NEEDED
|
||
MOVN D,R
|
||
ADDM D,2(A) ;ADJUST COUNT IN BUFFER HEADER
|
||
MOVE D,1(A) ;GET BYTE POINTER TO INPUT BUFFER
|
||
HRLI D,1(D)
|
||
HRRI D,(T) ;FORM BLT POINTER
|
||
ADDI T,(R) ;UPDATE POINTER INTO TARGET ARRAY
|
||
ADDM R,1(A) ;UPDATE INPUT BUFFER BYTE POINTER
|
||
BLT D,-1(T) ;TRANSFER DATA TO TARGET ARRAY
|
||
JUMPLE TT,BLTXIT ;EXIT IF WE GOT ENOUGH DATA
|
||
BLTI5: XCT B ;GET MORE DATA
|
||
JRST BLTI6 ;JUMP IF AN ERROR OCCURRED
|
||
MOVE D,FB.BFL(F)
|
||
ADDM D,F.FPOS(F) ;UPDATE FILE POSITION
|
||
JRST BLTI3
|
||
|
||
BLTI6: MOVE D,B ;CONSTRUCT A TEST FOR END OF FILE
|
||
XOR D,[<STATO 0,IO.EOF>#<IN 0,>]
|
||
XCT D
|
||
HALT ;LOSE TOTALLY IF NOT END OF FILE
|
||
] ;END OF IFN D10
|
||
HRRZ C,FI.EOF(TT) ;GET EOF FUNCTION FOR FILE
|
||
UNLOCKI
|
||
JUMPE C,BLTI8
|
||
MOVEI A,(AR1)
|
||
JCALLF 1,(C) ;CALL USER EOF FUNCTION
|
||
|
||
BLTI8: MOVEI A,(AR2A)
|
||
CALL 1,.FUNCTION NCONS
|
||
MOVEI B,(AR1)
|
||
CALL 2,.FUNCTION XCONS
|
||
MOVEI B,.ATOM FILLARRAY
|
||
CALL 2,.FUNCTION XCONS
|
||
IOL [EOF - FILLARRAY!] ;ELSE GIVE IO-LOSSAGE ERROR
|
||
|
||
|
||
IFN ITS,[
|
||
BSIOT: SETZ
|
||
SIXBIT \SIOT\ ;STRING I/O TRANSFER
|
||
,,F.CHAN(TT) ;CHANNEL #
|
||
,,T ;BYTE POINTER
|
||
400000,,D ;BYTE COUNT
|
||
]
|
||
|
||
FASEND
|