;;; 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-,[ 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-, IFE .OSMIDAS-,[ 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-, IFE .OSMIDAS-,[ 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-, IFE .OSMIDAS-,[ 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-, IFNDEF $INSRT, .FATAL SO WHAT KIND OF OPERATING SYSTEM IS THIS ANYWAY??? DEFINE $FNAME FOO ;PRINTX A FILE NAME GIVEN NUMERIC SIXBIT ZZX== 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,[#] 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