rAgR#_<'J~E&|gR8$g[5+q pKNKy$T&Azïoo"Lr8[C@"D]d!8]$H/~5TV'H]J,(#qA8]ZL@0"%'Hg2i 0DK"Q8m@"Pڀ8mA"QE8] ; MOBY I/O PACKAGE ;;; ***** MACLISP ****** MOBY I/O PACKAGE ************************ ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** PGBOT MIO SUBTTL VIDISECTOR ROUTINES NVID: PUSHJ P,NVIDI ;BREAKS OUT WITH POPJ IF LOSES TLNE TT,3 MOVSI TT,217400 ;16384.0 IN PDP10 MACHINE WORD JRST FLOAT1 NVIDI: SKIPE FTVU ;LEAVES ANSWER IN TT JRST NVIDI2 SKIPN NVDOPD PUSHJ P,NVDOPN NVIDI2: MOVE AR1,A ;GC PROTECT THIS HRR D,B HRL D,A MOVE C,[-1,,D] PUSHJ P,NVDPRE JRST NVIDI3 SKIPN FTVU JRST NVIDI1 HLRE TT,D ;ORDINARY CALL TO FAKETV HRRES D PUSHJ P,FAKETV JRST NVIDI3 POPJ P, NVIDI1: .IOT NVDC,D SETZM NVDOPD .CLOSE NVDC, MOVE TT,D POPJ P, NVIDI3: PUSHJ P,NCONS MOVEI B,QNVFIX ;REQUESTED POINTS OUT OF RANGE PUSHJ P,XCONS ;ERROR ROUTINE TO PRODUCE ALTERNATIVE SUB P,R70+1 ;CAUSES BREAK OUT OF NVID OR NVFIX FAC [NON-EXISTENT VIDI POINT!] NVDP4: MOVE F,TT MOVEI R,0 ASHC R,22 DIV R,NVSCL MOVEI TT,0 ASHC TT,22 DIV TT,NVSCL NVDP3: JSP T,FIX1A ;GET A LIST OF THE TWO NUMBERS PUSHJ P,NCONS ;([R] [TT]) MOVE B,A MOVE TT,R JSP T,FIX1A JRST CONS ;;; IFN MOBIOF NVDPRE: JFCL 8.,.+1 HLRZ A,(C) ;PRE-VIDISSECTING PROCESSING JSP T,FXNV1 MOVE R,TT IMUL TT,NVSCL ADDI TT,400000 ;ROUNDING SKIPL TT CAML TT,[40000,,] JRST NVDP1 JFCL 8.,NVDP1 HLLM TT,(C) HRRZ A,(C) JSP T,FXNV1 IMUL TT,NVSCL ADDI TT,400000 SKIPL TT CAML TT,[40000,,] JRST NVDP2 JFCL 8.,NVDP2 HLRM TT,(C) AOBJN C,NVDPRE JRST POPJ1 ;SKIP ON SUCCESSFUL EXIT NVDP1: HRRZ A,(C) NVDP2: JSP T,FXNV1 JRST NVDP3 NVDPST: MOVE TT,(C) ;POST-VIDISSECTING PROCESSING PUSHJ P,NVFX2 MOVEM A,(C) AOBJN C,NVDPST POPJ P, NVFIX: PUSH P,B PUSH P,A NVFX1: PUSHJ P,NUMBERP JUMPE A,NVFXB POP P,A POP P,B PUSHJ P,NVIDI NVFX2: TLNN TT,3 ;DIM CUTOFF, OR COUNTER OVERFLOW TLZA TT,-1 MOVEI TT,40000 ;16384. JRST FIX1 OPNGEN NVD,0 OPNGEN BVD,2,NVD ;;; IFN MOBIOF NVFXB: MOVE A,(P) ;WHOLE BLOCK OF VALUES IN AN ARRAY PUSHJ P,AREGET ;TO BE DISSECTTED PUSH P,A MOVE A,-2(P) JSP T,FXNV1 LOCKI MOVN AR1,TT HRRZ C,(P) HRRZ C,TTSAR(C) HRL C,AR1 ;AOBJN PTR TO ARRAY ENTRIES FOR HACKING MOVE AR1,C ;SAVE IN AR1 PUSHJ P,NVDPRE JRST NVFXE3 SKIPE FTVU JRST NVFXB2 SKIPN BVDOPD PUSHJ P,BVDOPN MOVE C,AR1 .IOT BVDC,AR1 ;FOR NLISP, WILL HAVE TO DO IT IN A SETZM BVDOPD .CLOSE BVDC, NVFXB3: PUSHJ P,NVDPST SUB P,R70+3 UNLOCKI JRST FALSE NVFXB2: HRRZ T,AR1 ;UPON ENTRY, CAN USE ARRAY PTR CALCULATED ABOVE HLLZS AR1 ;- IN LH TVFS1: HLRE TT,(T) HRRE D,(T) PUSH FXP,AR1 PUSHJ P,FAKETV ;MIGHT GC ARRAY SPACE JRST NVFXE2 POP FXP,AR1 HRR T,(P) HRR T,TTSAR(T) ADD T,AR1 MOVEM TT,(T) ;PUT BACK VIDI VALUE AOBJN AR1,[AOJA T,TVFS1] SUBI T,-1(AR1) ;RESTORE T TO BE PTR TO ARRAY BEGIN MOVNS AR1 HRL T,AR1 MOVE C,T JRST NVFXB3 NVFXE2: SUB FXP,R70+1 ;FIX UP PDLS, AND GO TO ERROUT NVFXE3: SUB P,R70+2 UNLOCKI JRST NVIDI3 ;;; IFN MOBIOF NVSET: PUSH P,AR2A LDB F,[251700,,ONVDC] NVFIL: JUMPE A,NVCONF JSP T,FXNV1 DPB TT,[100200,,F] TRNN TT,4 TRZA F,10_10 TRO F,10_10 NVCONF: JUMPE B,NVRES JSP T,FXNV2 MOVEM D,NVCFL DPB D,[000200,,F] NVRES: JUMPE C,NVDIM JSP T,FXNV3 HRLZI T,40000 IDIVM T,R MOVEM R,NVSCL NVDIM: JUMPE AR1,NVXYZ MOVE A,AR1 JSP T,FXNV1 MOVEM TT,NVDCL DPB TT,[020300,,F] NVXYZ: POP P,A JUMPE A,NVST1 JSP T,FXNV1 JUMPN TT,.+2 TRZA F,340 TRO F,340 NVST1: DPB F,[251700,,ONVDC] DPB F,[251700,,OBVDC] SETZM NVDOPD PUSH P,R70 MOVE TT,NVCFL JSP T,FXCONS PUSH P,A HRLZI TT,40000 IDIV TT,NVSCL JSP T,FIX1A PUSH P,A MOVE TT,NVDCL JSP T,FXCONS PUSH P,A PUSH P,R70 MOVNI T,5 JRST LIST ;;; IFN MOBIOF SUBTTL FAKE TV STUFF ;FUNCTIONS THAT ALLOW READING VIDISECTOR VALUES ; FROM A STORED IMAGE SUBSIZ==64. ;SUB-PICTURE SIZE VIDIS==4. ;NUMBER OF VIDI VALUES PER WORD XWRDS==SUBSIZ/VIDIS WRDBLK==SUBSIZ*XWRDS ;NUMBER WORDS IN A SUB-PICTURE FRESL==16. ;STORED IMAGE HAS 1 OUT OF EVERY 16. POINTS HFRESL==8. ;THIS CODE SETS UP THE MAXIMUM NUMBER OF BUFFERS USED BEFORE ;PAGING OUT ONE BLOCK AND READING ANOTHER IN OVER ITS BUFFER SSFTVS: IFE NSTAT,[ JSP T,FXNV2 MOVEM TT+1,MFTVBL ] ;END OF IFE NSTAT IFN NSTAT,[ JSP T,FXNV1 MOVEM TT,MFTVBL ] ;END OF IFN NSTAT JRST TRUE FKTV2A: SUB FXP,R70+2 ADD TT,XLL ADD TT+1,YLL FKTV4: PUSHJ P,NVDP4 JRST FTVX ;NO SKIP IF POINTS OUT OF RANGE ;THIS ROUTINE WILL READ A VIDI VALUE FROM THE STORED IMAGE ; OPENED BY FTVOPN ; TT=X POSITION (OUT OF 16384.) ; D=Y POSITION FAKETV: LOCKI CAML TT,XLL CAMLE TT,XUR JRST FKTV4 ;NO SKIP IF POINTS OUT OF RANGE CAML TT+1,YLL CAMLE TT+1,YUR JRST FKTV4 ;NO SKIP IF POINTS OUT OF RANGE SUB TT,XLL SUB TT+1,YLL MOVE A,TT IDIVI A,FRESL CAIL B,HFRESL AOS A ;CONVERT TO 1024. POINT FRAME SIZE MOVE B,TT+1 IDIVI B,FRESL CAIL C,HFRESL AOS B IDIVI B,SUBSIZ ;COMPUTE BLOCK NUMBER THAT CONTAINS POINT PUSH FXP,C IMUL B,XBLOKS EXCH A,B IDIVI B,SUBSIZ PUSH FXP,C ADDI A,1(B) ;MUST HAVE FEWER THAN 2_18. BLOKS ;;; IFN MOBIOF CAMN A,CURBLK ;IS IT THE CURRENT BLOCK? JRST FKTV1 ;YUP CAMLE A,NBLOKS ;IS IT A REAL BLOCK? JRST FKTV2A PUSH FXP,A PUSHJ P,FTGTBF POP FXP,A JUMPN B,FKTV1 ;IF BLOCK FOUND ON BLOKLIST, GO FTV1 IMULI A,WRDBLK ;IF NOT, THEN BUFFER IS READY FOR IOT INTO IT .ACCESS FTVC,A ;GO TO BEGINNING OF DISK BLOCK MOVNI A,WRDBLK HRLZS A HRR A,BUFFER HRR A,TTSAR(A) .IOT FTVC,A ;AND READ IT INTO CORE FKTV1: MOVE B,NVDCL ;GET CURRENT DCL CAMN B,ODCL JRST FKTV3 ;NO CHANGE MOVEM B,ODCL ;SET NEW LEVEL SKIPE B CAIN B,7 MOVEI B,1 IMULI B,100 MOVNS B ADDI B,1300 MOVEM B,NVDK ;COMPUTE NEW DIM CUTOFF VALUE FKTV3: POP FXP,B POP FXP,C VIDGET: HRRZ A,BUFFER ;THIS ROUTINE GETS A VIDI VALUE HRRZ A,TTSAR(A) ;FROM THE CURRENT BLOCK IMULI C,XWRDS ;B=X POSITION IN BLOCK ADD A,C ;C=Y POSITION IN BLOCK IDIVI B,VIDIS ADD A,B ;ADDRESS OF WORD CONTAINING DESIRED BYTE SUBI C,3 MOVMS C IMULI C,110000 ;COMPUTE BYTE POINTER ADDI C,1100 ;9 BITS PER BYTE HRL A,C LDB A,A ;GET BYTE ADDI A,201 CAMLE A,NVDK MOVE A,NVDK ;DIM CUTOFF HACK LDB B,[60600,,A] ;RECREATE VIDI WORD FORMAT ADDI B,224 MOVE C,A TRZ C,777700 ;GET RID OF EXPONENT ADDI C,100 FSC C,(B) HLL A,C MOVE TT,A SETZB A,AR1 AOS (P) ;NORMAL EXIT FROM FAKETV SKIPS ONE JRST FTVX ;;; IFN MOBIOF ;HERE WE GET THE TITLE ON THE FAKE TV FILE SFTVTITLE: SKIPN FTVU JRST FALSE SKIPE CURBLK ;HEADER FOR FAKETV PUSHJ P,PINIT ;MAKE SURE BLOCK 0 IS CURRENT LOCKTOPOPJ HRRZ R,BUFFER ;SAR WORD IN TT+2 HRRZ R,TTSAR(R) SKIPN 3(R) ;GET HEADER DESCRIPTION AS LIST JRST FALSE ADDI R,3 HRLI R,440700 MOVEM R,CORBP MOVEI A,SFTIT SETZB B,MKNM3 JRST READ0A SFTIT: ILDB A,CORBP POPJ P, PINIT: PUSH P,FTVU ;MAKE SURE BLOCK ZERO IS CURRENT LOCKI JRST SSFTV1 SSFTV: PUSHJ P,FTVOPN SFTV: SKIPN FTVU JRST FALSE MOVE TT,XLL MOVE TT+1,YLL PUSHJ P,NVDP4 MOVE C,A MOVE TT,XUR MOVE TT+1,YUR PUSHJ P,NVDP4 MOVE B,FTVU PUSHJ P,CONS MOVE B,C JRST XCONS ;;; IFN MOBIOF ;;; THIS FUNCTION OPENS THE IMAGE FILE AND COMPUTES SOME NEEDED VALUES FTOPNER: UNLOCKI POP P,A MOVEI B,QUREAD PUSHJ P,XCONS FAC [TV FILE NOT FOUND!] FTVOPN: SETZM FTVU SETZM FTVBL SETZM NFTVBL JUMPE A,CPOPJ HRRZ T,(A) JUMPE T,CPOPJ PUSH P,A MOVEI T,6 PUSHJ P,UINITA MOVE T,[UTIN,,FTVO] BLT T,FTVO+2 SSFTV1: MOVEI A,0 PUSHJ P,FTGTBF ;GET A BUFFER REGION FOR BLOCK 0 JUMPN B,POP1J ;FINDABLE ONLY ON NON-INITIAL TRIES .OPEN FTVC,FTVO JRST FTOPNER POP P,FTVU SETZM CURBLK SETOM ODCL ;FORCE RECOMPUTATION OF DIM CUTOFF VALUE HRRZ A,BUFFER ;FIRST TIME THRU FAKETV HRRZ A,TTSAR(A) HRLI A,-2000 .IOT FTVC,A ;READ HEADER HRRZ B,BUFFER ;XLL,,YLL HRRZ B,TTSAR(B) MOVE A,(B) HLRZM A,XLL HRRZM A,YLL MOVE A,1(B) ;XUR,,YUR HLRZM A,XUR HRRZM A,YUR MOVE A,XUR SUB A,XLL IDIVI A,SUBSIZ*FRESL SKIPE B AOS A ;ROUND OFF MOVEM A,XBLOKS MOVE A,YUR SUB A,YLL IDIVI A,SUBSIZ*FRESL SKIPE B AOS A MOVEM A,YBLOKS IMUL A,XBLOKS MOVEM A,NBLOKS ;NUMBER OF SUB-PICTURES IN FILE FTVX: SETZB B,C UNLKPOPJ ;;; IFN MOBIOF FTGTBF: PUSH P,A ;BLOCK NO. IN A HRRZ B,FTVBL ;ALLOCATE A BUFFER AREA, JUMPE B,FTGBF2 PUSHJ P,SAS1 JRST FTGBF1 ;SIGNAL IF DESIRED BLOCK IS FOUND MOVEI B,TRUTH ;AND IS IN BUFFER AREA FTGBF3: HRRZ A,(A) ;MAKE THE FOUND ENTRY CURRENT MOVEM A,BUFFER POP P,CURBLK POPJ P, FTGBF1: MOVE T,MFTVBL ;SO GRAB BUFFER AT FRONT OF QUEUE CAMLE T,NFTVBL ;BRING TO END OF QUEUE, AND USE JRST FTGBF2 ;IT FOR STORAGE OF DESIRED BLOCK CAIG T,200 CAIGE T,1 JRST FTGBF6 MOVE A,FTVBL HRRZ B,(A) HLLOS NOQUIT HRRM B,FTVBL ;CDR THE BLOCKS LIST HLLZS (A) HLRZ B,A ;POINTER TO CURRENT END OF BLOCKS LIST HRRM A,(B) ;LIST IS NOW ROTATED ONE HRLM A,FTVBL ;UPDATE POINTER TO END OF LIST HLRZ A,(A) MOVE B,(P) ;ROTATED BUFFER IS GRABBED FOR DESIRED BLOCK HRLM B,(A) FTGBF4: PUSHJ P,CZECHI MOVEI B,NIL ;SIGNAL THAT DESIRED BLOCK NOT IN CORE YET JRST FTGBF3 ;BUT A BUFFER HAS BEEN SET UP FOR IT FTGBF6: MOVEI T,4 MOVEM T,MFTVBL FTGBF2: MOVEI A,NIL MOVEI TT,2000 PUSHJ P,MKFXAR MOVE A,(P) PUSHJ P,CONS PUSHJ P,NCONS ;STRUCTURE OF BLOCKS LIST IS DOTTED PAIRS HLRZ B,FTVBL ;WITH BLOCK NO. IN LH, ADDRESS OF SAR HLLOS NOQUIT ;FOR BUFFER IN RH HRLM A,FTVBL SKIPN B MOVEI B,FTVBL HRRM A,(B) ;SPLICE IN NEW ENTRY AT LAST OF LIST HLRZ A,(A) AOS NFTVBL ;INFORM THAT ONE MORE BLOCK HAS BEEN TAKEN JRST FTGBF4 ;;; IFN MOBIOF SUBTTL DISPLAY SLAVE ROUTINES ZZ==P6+100 .XCREF ZZ IRP A,,[DENABL,DFUNCTION,ERRLOC,ASTATE,ARYNUM,XARG,YARG,PENPOS,DBRITE DSCALE,WRDCNT,MORFLG,DBUFFER] A==ZZ ZZ==ZZ+1 .XCREF ZZ TERMIN ;ARGUNEMT CELLS BFLNTH==1776-DBUFFER+P6 ZZ==1 .XCREF ZZ IRP A,,[CREATE,DISADD,DISSUB,DFLUSH,DDISALINE,DCLEAR,DMOVE,DGET,DSEND BLINK,UNBLINK,DCHANGE,DTEXT,DCOPY,WHERE,DPOINT,DNOOP,SHOWPEN,HIDEPEN LINK,UNLINK,MOTION,DLISTINF,DLIST,DSET,DFRAME] A==ZZ ZZ=ZZ+1 .XCREF ZZ TERMIN DISPLAY: MOVEI R,DISADD ;FOR BACKTRACEING PURPOSES, THIS IS HERE JRST DISP1 CN.Y: JSR CLZDIS SKIPE DISON SKIPN SIXOPD JRST 2,@CNTROL SETZM DENABL SETZM DISON JSR DISLEEP JRST YF.MES JRST 2,@CNTROL CN.F: SKIPN DISON SKIPN SIXOPD ;CAUSES SLAVE TO TRY TO GRAB 340 JRST 2,@CNTROL ;IF IT DOESN'T ALREADY HAVE IT JSR CLZDIS SETOM DENABL JSR DISLEEP JRST YF.MES AOS DISON JRST 2,@CNTROL YF.MES: SAVE 40 UUOH SAVEFX UUTSV UUTTSV UURSV PUSHJ P,SAVX5 PUSHJ FXP,SAV5 STRT @DERR0(A) JSP R,RSTR5 PUSHJ P,RSTX5 RSTRFX UURSV UUTTSV UUTSV RSTR UUOH 40 JRST 2,@CNTROL ;;; IFN MOBIOF ;CLZDIS: 0 CLZDS1: SETZM DISPON ;(SETQ ^N NIL) SKIPE DISOPD .CLOSE DISC, ;RELEASES DIS DEVICE IF JOB HAS IT SETZM DISOPD JRST 2,@CLZDIS ;DISLEEP: 0 DISLP1: MOVEI A,DNOOP ;USED AT INTERRUPT LEVEL, SO ONLY ACC A IS AVAILABLE MOVEM A,DFUNCTION AOS DISLEEP ;SKIPS IF SLAVE IS ALIVE AND WELL MOVEI A,20. ;ELSE, NOSKIP AND LEAVE ERROR NUMBER IN A SKIPL SIXOPD MOVEI A,100. ;FOR PDP10, WAIT UP TO 3.3 SECONDS MOVEM A,DISLP2 ;[FOR PDP6, UP TO .6 SECS] FOR SLAVE TO RESPOND DISLP3: MOVEI A,1 .SLEEP A, SKIPE A,ERRLOC DISLP4: SOSA DISLEEP SKIPN DFUNCTION JRST 2,@DISLEEP SOSL DISLP2 JRST DISLP3 JRST DISLP4 WAITSK: MOVEI F,1111. ;WAITS 1/30TH OF A SECOND, IN FAST MODE XCT (T) SOJN F,.-1 JUMPN F,2(T) MOVEI F,30. ;JDC SAYS 10. ISN'T ENOUGH SKIPL SIXOPD MOVEI F,100. ;SKIP IF XCT'D SKIP WORKS WITHIN SOME WASKP1: JUMPLE F,1(T) ;REASONABLE QUANTUM. BUT NO SKIP IF MOVEI D,1 ;IT DOESN'T .SLEEP D, ;THEN WAITS N 30THS OF A SECOND WASKP2: XCT (T) ;IN SLOW MODE SOJA F,WASKP1 JRST 2(T) ;;; IFN MOBIOF CLSSIX: SKIPN SIXOPD POPJ P, LOCKI SETZM DENABL JSR DISLEEP MOVEI A,NIL SETZM DISON SETZM SIXOPD MOVE TT,[002000+SIXC,,_9.] ;FLUSH PAGES FROM MY PAGE TABLE .CBLK TT, JFCL .UCLOSE SIXC, UNLKPOPJ OPNSIX: SKIPE SIXOPD POPJ P, OP6D: LOCKI ;R<0 => SLAVE IS PDP6, >0 => PDP10 MOVNI R,1 ;R=0 => TRYING TO LOAD 6'S MEMORY AND START UP .OPEN SIXC,[SIXBIT \ 'USR PDP6 \] JRST OP10 OP6D2: MOVE TT,[002400+SIXC,,<400000+_11>] .CBLK TT, ;MAKE PAGE 0 OF SIX INTO PAGE OF 10 .VALUE OPD62A: MOVEM R,SIXOPD ;IF OPENING 6, THEN R=-1 WILL ALLOW SECOND TRY OP6A: MOVEI TT,DCLEAR ;R = 0 SAYS TRY 10SLAVE IF NO RESPONSE MOVEM TT,DFUNCTION JSP T,WAITSK SKIPE DFUNCTION JRST OP6C AOS DISON SETZM MORFLG SKIPL SIXOPD ;CLEARING WORRKED, SO SLAVE IS RUNNING WELL UNLKPOPJ JSP D,OPDSMS ;ANNOUNCE FACT, IF PDP6 WAS GRABBED SETZ [SIXBIT \SLAVE GRABBED^M!\] UNLKPOPJ ;;; IFN MOBIOF OP6C: JUMPGE R,OP6B ;ON FIRST FAILURE, TRY TO LOAD DISPLAY FROM DISC .OPEN DSIC,[SIXBIT \ &SYSATSIGN6SLAVE\] OP6C1: LERR DERR1 .RESET SIXC, .CALL LSIXC ;LOAD UP SIX .VALUE MOVE TT,[JRST 2000] ;IF PDP6 IS RUNNING, IT WILL BE AT LOCATION 41 MOVEM TT,P6+41 .CLOSE DSIC, AOJA R,OP6A ;;; IFN MOBIOF OP10: JSP D,OPDSMS [SIXBIT \NOT AVAILABLE!\] JRST OPNTEN OP6B: PUSHJ P,CLSSIX JUMPN R,DERR0 JSP D,OPDSMS [SIXBIT \NOT RUNNING!\] OPNTEN: MOVE T,[6,,(SIXBIT \USR\)] .SUSET [.RUNAME,,TT] MOVE D,[SIXBIT \DSLAVE\] .OPEN SIXC,T .VALUE .OPEN DSIC,[SIXBIT \ &SYSATSIGN10SLAV\] JRST OP6C1 .CALL LSIXC .VALUE .CLOSE DSIC, MOVE TT,[002400+SIXC,,<400000+_11>] .CBLK TT, ;MAKE PAGE 0 OF SLAVE INTO PAGE OF 10 .VALUE MOVEM F,XARG ;0 => 340 SLAVE, "TNM" => GT40 SLAVE .USET SIXC,[.SUPC,,[2000]] ;LOC OF STARTING ADDRESS .USET SIXC,[.SUSTP,,R70] ;BREATHE SOME LIFE INTO SLAVE MOVEI R,1 ;R=1 SAYS 10SLAVE TAKEN JRST OP6D2 OPDSMS: PUSHJ P,IOGBND STRT [SIXBIT \^MPDP6 !\] STRT @(D) SKIPL (D) ;SKIP FOLLOWING MSG IF ANNOUNCING PDP6 GRABBED STRT [SIXBIT \ TRYING PDP10 SLAVE^M!\] PUSHJ P,UNBIND JRST 1(D) LSIXC: SETZ SIXBIT \LOAD\ 1000,,SIXC 401000,,DSIC ;;; IFN MOBIOF CK6OPN: SKIPE SIXOPD ;QUICK CHECK FOR A WORKING SLAVE JRST (T) PUSH P,T CK6NOPN: SKIPE SIXOPD ;LOOP AROUND THE FAIL-ACT UNTIL SLAVE IS OPENED CCK6NOPN: POPJ P,CK6NOPN DISNOPN: PUSH P,CCK6NOPN ;CAUSES RETRY OF TEST, AND EXIT THRU (T) IF WIN %FAC DERR2 CSENDIT: SKIPN SIXOPD ;CHECK FIRST, THEN SENDIT PUSHJ P,DISNOPN MOVEM R,ARYNUM ;ARYNUM ARGUMENT IN R SENDIT: MOVEM TT,DFUNCTION ;TT=FUNCTION NUMBER SNDT1: AOS (P) ;SKIP IF WIN SNDT1A: JSP T,WAITSK SKIPE DFUNCTION JRST SNDT2 ERRTST: MOVE TT,ARYNUM ;LEAVE ARYNUM IN TT SKIPN D,ERRLOC ;MUST BE AN ERROR POPJ P, ;ERRLOC=0 => NO ERRORS ERTST1: JSP T,FIX1A PUSHJ P,NCONS MOVEI B,QDISPLAY PUSHJ P,XCONS SOS (P) ;NO SKIP IF LOSE %FAC @DERR0(D) SNDT2: SKIPE ERRLOC ;COME HERE WHEN THINGS HAVE BEEN GOING ON FOR A LONG TIME JRST ERRTST CAIE TT,DFRAME CAIN TT,MOTION ;TT STILL HAS DFUNCTION IN IT JRST SNDT1A ;MOTION IS ALLOWED TO GO ON FOR EVER SETZB TT,D ;DEAD SLAVE - BOO HOO JRST ERTST1 DISINI: AOJG T,DCLR1 ;LSUBR (0 . 2) AOJL T,DISTMA SETZ F, JUMPN T,DCLR5 POP P,A PUSHJ P,SIXMAK HLRZ F,TT PUSHJ P,CLSSIX LOCKI PUSHJ P,OPNTEN JRST DCLR5A DCLR5: PUSHJ P,OPNSIX ;GRAB SLAVE IF POSSIBLE DCLR5A: POP P,A ;IF ARGUMENT GIVEN, THEN SET ASTATE JSP T,FXNV1 DCLR3: JUMPL TT,.+2 CAILE TT,3 ;IF ARG NOT IN RANGE 0 - 3, THEN DONT CHANGE ASTATE MOVE TT,ASTATE EXCH TT,ASTATE JRST FIX1 DCLR1: SKIPN SIXOPD JRST DCLR4 MOVEI TT,DCLEAR ;OTHERWISE SIMPLY CLEAR AND INITIALIZE MOVEM TT,DFUNCTION JSP T,WAITSKP SKIPE DFUNCTION JRST SNDT2 JRST DCLR3 DCLR4: SETZ F, PUSHJ P,OPNSIX MOVE TT,ASTATE JRST FIX1 ;;; IFN MOBIOF DISCREATE: MOVE TT,T JSP T,CK6OPN SETZM XARG SETZM YARG AOJG TT,DSCRT1 AOJN TT,DISTMA POP P,C POP P,B PUSHJ P,DISXY DSCRT1: MOVEI TT,CREATE PUSHJ P,SENDIT POPJ P, ;CUT OUT ON FAILURE JRST FIX1 DISCOPY: MOVEI R,DCOPY PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE JRST FIX1 DISBLINK: MOVEI R,BLINK ;DISPLAY ALSO ENTERS HERE DISP1: SKIPN B ;ENTER WITH FUN NUMBER IN R, LISP NUM FOR ARYNUM IN A AOSA R ;DISADD ==> DISSUB, BLINK ==> UNBLINK, ETC. DISP1C: MOVEI B,TRUTH PUSHJ P,DISP1B JFCL JRST SPROG2 DISP1B: JSP T,FXNV1 ;SKIPS IF ACTION WINS EXCH TT,R ;ARYNUM IN R, FUNCTION IN TT DISXIT: PUSHJ P,CSENDIT POPJ P, ;CUT OUT ON FAILURE DISXT2: AOS (P) POPJ P, DISLINK: MOVEI R,LINK JSP T,FXNV2 MOVE B,C JRST DSMK1 DISMARK: MOVEI R,SHOWPEN JSP T,FXNV2 HRLZ B,TT+1 ;IF 2ND ARG IS 0, THEN DO A UNMARK DSMK1: JSP T,CK6OPN MOVEM TT+1,XARG JRST DISP1 DISFRAME: JSP T,FXNV1 JSP T,CK6OPN MOVEM TT,WRDCNT MOVEI TT,DFRAME PUSHJ P,SENDIT JFCL JRST TRUE ;;; IFN MOBIOF DISET: MOVEI F,1 MOVNI TT,2 JSP D,PPBSL MOVEI R,DSET JRST DAL2 DISFLUSH: MOVEI A,NIL AOJG T,CLSSIX ;(DISFLUSH) SAYS TO FLUSH SLAVE MOVN C,T MOVEI R,DFLUSH ;(DISFLUSH N) SAYS FLUSH DISPLAY ITEM N POP P,A PUSHJ P,DISP1B JFCL SOJGE C,.-3 JRST TRUE DISAPOINT: MOVEI R,DPOINT JRST DAL0 DISALINE: MOVEI R,DDISALINE DAL0: MOVNI TT,2 MOVEI F,3 JSP D,PPBSL DAL1: POP P,B POP P,A MOVEI T,3 CAMN T,ASTATE JRST DAL3 DAL4: JSP T,FXNV1 JSP T,FXNV2 DAL5: MOVEM TT,XARG MOVEM TT+1,YARG DAL2: POP P,A JRST DISP1C DAL3: JSP T,FLTSKP ;OOPS, POLAR COORDINATES JSP T,DALMES MOVE A,B MOVE TT+1,TT JSP T,FLTSKP JSP T,DALMES EXCH TT,TT+1 JRST DAL5 DISLOCATE: PUSHJ P,DISXY MOVEI R,DMOVE JRST DISP1C DISXY: MOVEI F,XARG ;YARG=XARG+1 DISXY1: JSP T,CK6OPN JSP T,FXNV2 MOVEM D,(F) JSP T,FXNV3 MOVEM R,1(F) POPJ P, ;;; IFN MOBIOF DSCLUZ: SUB P,R70+3 ;LOSE AT DISCUSS POPJ P, DISCUSS: MOVEI F,4 MOVNI TT,1 JSP D,PPBSL POP P,A DSCS2: MOVEI TT,0 PUSH P,[DSCLUZ] ;JUST IN CASE MFGWT LOSES JSP T,MFGWT ;SO NOW 6 IS LOCKED OUT OF BUFFER SUB P,R70+1 HRROI R,DSCS1 MOVNI AR1,BFLNTH*BYTSWD MOVE AR2A,[440700,,DBUFFER] PUSHJ P,PRINTA MOVEI TT,BFLNTH*BYTSWD(AR1) ;# OF BYTES INSRTED MOVEM TT,WRDCNT MOVEI R,DTEXT SETOM MORFLG JRST DAL1 DSCS1: AOSGE AR1 ;FUNCTION CALLED BY PRINC IDPB A,AR2A POPJ P, PPBSL: SKIPN SIXOPD ;PROCESS OPTIONAL BSL AND PENPOS ARGS PUSHJ P,DISNOPN ;F HOLDS NUMBER OF REQUIRED ARGS ADD F,T ;TT HOLDS - CAML F,TT CAILE F,0 DISTMA: LERR DERR3 ;WNA - DSLAVE PPBSL1: JUMPE F,(D) MOVE A,(P) JUMPE A,PPBSL2 PUSHJ P,TYPEP CAIN A,QLIST JRST PPBSL3 AOJE TT,.+2 ;IF ONLY ONE OPTIONAL PERMITTED, IT MUST BE BSL CAIE A,QFIXNUM JRST PPBSL4 MOVE A,(P) JSP T,FXNV1 MOVEM TT,PENPOS PPBSL2: SUB P,[1,,1] MOVEI TT,0 AOJA F,PPBSL1 PPBSL3: MOVE A,(P) ;PROCESS A BSL LIST HLRZ A,(A) JSP T,FXNV1 MOVEM TT,DBRITE HRRZ A,@(P) JUMPE A,PPBSL2 HLRZ A,(A) JSP T,FXNV1 MOVEM TT,DSCALE JRST PPBSL2 ;;; IFN MOBIOF DISCHANGE: MOVEI F,DBRITE ;DSCALE=DBRITE+1 PUSHJ P,DISXY1 MOVEI R,DCHANGE JRST DISP1C DISMOTION: PUSHJ P,DISXY EXCH A,AR1 JSP T,FLTSKP JSP T,IFLOAT EXCH A,AR1 MOVEM TT,WRDCNT MOVEI R,MOTION PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE MOVE D,[-2,,XARG] JRST DSCB1A DISLIST: AOJG T,DSLS1 JUMPN T,DISTMA POP P,A MOVEI R,DLISTINF PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE JRST DSLS2 DSLS1: MOVEI TT,DLIST PUSHJ P,CSENDIT POPJ P, ;CUT OUT ON FAILURE DSLS2: MOVN D,XARG JUMPE D,FALSE HRLI D,DBUFFER MOVSS D JRST DSCB1A DISCRIBE: MOVEI R,WHERE PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE MOVE D,[-10,,DBUFFER] DSCB1A: MOVEI B,NIL HLRE R,D DSCB1: MOVE TT,(D) JSP T,FIX1A PUSH P,A AOBJN D,DSCB1 MOVE T,R JRST LIST MFGWT: SKIPN MORFLG ;MORFLG WAIT - I.E., WAIT UNTIL MORFLG GOES TO ZERO JRST (T) PUSH P,T JSP T,WAITSK SKIPE MORFLG JRST .+2 POPJ P, SUB P,R70+1 AOS (P) JRST SNDT2 ;;; IFN MOBIOF DISGORGE: JSP T,CK6OPN JSP T,MFGWT SETOM MORFLG JSP T,FXNV1 MOVEM TT,ARYNUM HRLOI R,DSEND HLRZM R,DFUNCTION JSP T,MFGWT MOVE TT,WRDCNT MOVEI A,NIL PUSHJ P,MKFXAR HRRZ R,TTSAR(B) MOVE TT,WRDCNT DSGRG1: JSP T,MFGWT CAIG TT,BFLNTH SKIPA F,TT MOVEI F,BFLNTH ADDI F,-1(R) HRLI R,DBUFFER BLT R,(F) MOVEI R,1(F) HRREI TT,-BFLNTH(TT) JUMPLE TT,CPOPJ SETOM MORFLG JRST DSGRG1 DISGOBBLE: PUSHJ P,SARGET JSP T,MFGWT MOVE R,ASAR(A) HLRE TT,-1(R) HRRZ R,-1(R) MOVNS TT MOVEM TT,WRDCNT MOVEI F,DGET MOVEM F,DFUNCTION DSGBL1: CAIG TT,BFLNTH SKIPA F,TT MOVEI F,BFLNTH MOVEI T,DBUFFER HRL T,R ADD R,F ADDI F,DBUFFER-1 BLT T,(F) HRREI TT,-BFLNTH(TT) SETOM MORFLG JSP T,MFGWT JUMPG TT,DSGBL1 PUSHJ P,SNDT1 POPJ P, ;CUT OUT ON FAILURE JRST FIX1 ;;; IFN MOBIOF PLOTLIST: MOVEI TT,0 AOJE T,PLTL1 AOJN T,PLTL2 POP P,A ;THE CHAR PLOTTED TO REPRESENT A SINGLE SCOPE POINT MOVEM P,PLTTBF ;MAY BE CHANGED BY GIVING PLOTLIST HRROI R,.+2 ;A SECOND ARGUMENT JRST PRINTA MOVE P,PLTTBF MOVEI TT,0 DPB A,[110700,,TT] PLTL1: POP P,PLTLST TDOA TT,[PLTLST,,767] PLOT: JSP T,FXNV1 PLOTC: JUMPE TT,UNPLOT SKIPN IPLOPD PUSHJ P,IPLOPN .IOT IPLC,TT JRST TRUE UNPLOT: .CLOSE IPLC, SETZM IPLOPD JRST FALSE PLOTTEXT: PUSH P,A PUSHJ P,PLT2 POP P,A HRROI R,PLT1 PUSHJ P,PRINTA MOVE TT,PLTTBF JRST PLOTC PLT1: IDPB A,PLTTBP MOVE A,PLTTBP TLNE A,760000 POPJ P, MOVE TT,PLTTBF PUSHJ P,PLOTC PLT2: MOVE A,[440700,,PLTTBF] MOVEM A,PLTTBP SETZM PLTTBF POPJ P, NEXTPLOT: MOVE TT,[034130,,77] ;PENUP AND NORMAL ORIENTATION PUSHJ P,PLOTC MOVE TT,[<1,,1>\<2300.,,0>_2] ;MOVE TO Y=0, X=2300. PUSHJ P,PLOTC MOVE TT,[<0,,1>\<0,,0>_2] ;DEFINE ORIGIN (0,0) PUSHJ P,PLOTC MOVE TT,[450000,,77] ;RESTORE ORIENTATION JRST PLOTC PLTL2: LERR [SIXBIT \WNA - PLOTLIST!\] OPNGEN IPL,5 PGTOP MIO,[MOBYIO PACKAGE] c ;;; ************************************************************** TITLE ***** MACLISP ****** ITS NEWIO MPX AND PLOTTER ROUTINES ****** ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** .FASL .INSRT SYS:.FASL DEFS VERPRT MPX ;;; MULTIPLEXOR INITIALIZATION ROUTINE ;;; (MPX ) SETS UP INPUT AND OUTPUT ;;; CHANNELS FOR THE MULTIPLEXOR. EACH ARG IS: ;;; NIL DO NOTHING ;;; 0 CLOSE CHANNEL ;;; 1 OPEN IN NORMAL MODE ;;; 2 OPEN IN FAST MODE .ENTRY MPX SUBR 000003 ;SUBR 2 MPX": PUSH P,A PUSH P,B MOVEI F,0 ;FIRST HACK INPUT JSP D,MPX4 SIXBIT \IMX\ .SPECIAL IMPX MOVEI F,1 ;THEN HACK OUTPUT MOVEI A,(B) JSP D,MPX4 SIXBIT \OMX\ .SPECIAL OMPX SUB P,[2,,2] MPXTRU": MOVEI A,.ATOM T POPJ P, MPX4": JUMPE A,CPOPJ ;NIL => DO NOTHING JSP T,FXNV1 JUMPN TT,MPX5 ;NON-ZERO => OPEN SKIPN A,@1(D) JRST 2(D) ;ALREADY CLOSED MOVEI TT,F.CHAN ;OTHERWISE CLOSE MPX FILE .CALL MPXCLS .VALUE SETZM @1(D) JRST 2(D) MPXCLS": SETZ SIXBIT \CLOSE\ ;CLOSE CHANNEL 400000,,@TTSAR(A) ;CHANNEL # MPX5": SOSE TT ;1 => NORMAL, 2 => FAST TRO F,4 PUSH FXP,F PUSH P,D SKIPN A,@1(D) ;MAY NEED TO CLOSE OLD JRST MPX5C ; MPX FILE FIRST MOVEI TT,F.CHAN .CALL MPXCLS .VALUE SETZM @1(D) MPX5C": MOVE TT,(D) ;ALLOCATE A FILE ARRAY PUSHJ P,ALFILE" ;LEAVES FILE ARRAY IN A, JRST MPXFLR ; CHANNEL # IN F POP P,D POP FXP,R ;MODE BITS .CALL MPXOPN IOJRST 2,MPX8 MOVEM A,@1(D) JRST 2(D) MPXOPN": SETZ SIXBIT \OPEN\ ;OPEN A FILE 4000,,R ;MODE BITS ,,F ;CHANNEL # 400000,,(D) ;DEVICE NAME MPX8": POP P,A CALL 1,.FUNCTION NCONS POP P,B CALL 2,.FUNCTION XCONS MOVEI B,.ATOM MPX MPXIOL": CALL 2,.FUNCTION XCONS %IOL (C) ;;; (IMPX ) INPUTS A FIXNUM VALUE FROM ;;; INPUT MULTIPLEXOR CHANNEL . .ENTRY IMPX SUBR 000002 ;SUBR 1 - NCALLABLE PUSH P,[FIX1] SKIPN AR1,.SPECIAL IMPX JRST IMPX8 JSP T,FXNV1 MOVE D,TT MOVEI TT,F.CHAN .CALL MPXIOT IOJRST 0,IMPX9 MPXRXT": MOVE TT,R POPJ P, MPXIOT": SETZ SIXBIT \IOT\ ;I/O TRANSFER ,,@TTSAR(AR1) ;CHANNEL # ,,D ;DATA 402000,,R ;RESULT IMPX8": MOVEI C,[SIXBIT \IMPX NOT OPEN!\] IMPX9": CALL 1,.FUNCTION NCONS MOVEI B,.ATOM IMPX JRST MPXIOL ;;; (OMPX ) OUTPUTS TO ;;; OUTPUT MULTIPLEXOR CHANNEL . .ENTRY OMPX SUBR 000003 ;SUBR 2 SKIPN AR1,.ATOM OMPX JRST OMPX8 JSP T,FXNV1 JSP T,FXNV2 LSH D,30 LSHC TT,-6 MOVEI TT,F.CHAN .CALL MPXIOT IOJRST 0,OMPX9 JRST MPXRXT OMPX8": MOVEI C,[SIXBIT \OMPX NOT OPEN!\] OMPX9": CALLF 2,.FUNCTION LIST MOVEI B,.ATOM OMPX JRST MPXIOL .SXEVAL (SETQ OMPX NIL IMPX NIL PLOT NIL) .ENTRY PLOTTEXT SUBR 000002 ;SUBR 1 PLOTTEXT": PUSH FXP,[0] MOVEI AR2A,(FXP) MOVSI AR1,(4407_24. (AR2A)) HRROI R,PLT1 PUSHJ P,PRINTA POP FXP,D JRST PLOTC PLT1": IDPB A,AR1 TLNE AR1,760000 POPJ P, MOVE D,(AR2A) PUSH P,AR2A PUSHJ P,PLOTC POP P,AR2A SETZM (AR2A) MOVSI AR1,(4407_24. (AR2A)) HRROI R,PLT1 POPJ P, .ENTRY NEXTPLOT SUBR 000001 ;SUBR 0 NEXTPLOT": PUSH FXP,[-LNXPTB] NXP1": MOVE D,-1(FXP) MOVE D,NXPTB+LNXPTB(D) PUSHJ P,PLOTC AOSGE (FXP) JRST NXP1 NXP2": SUB FXP,[1,,1] POPJ P, NXPTB": 034130,,77 ;PENUP AND NORMAL ORIENTATION <1,,1>\<2300.,,0>_2 ;MOVE TO Y=0, X=2300. <0,,1>\<0,,0>_2 ;DEFINE ORIGIN (0,0) 450000,,77 ;RESTORE ORIENTATION LNXPTB==.-NXPTB .ENTRY PLOT SUBR 000002 ;SUBR 1 PLOT": MOVE D,(A) PLOTC": JUMPE D,UNPLOT SKIPN A,.SPECIAL PLOT PUSHJ P,IPLOPN MOVEI AR1,(A) MOVEI TT,F.CHAN .CALL MPXIOT IOJRST 0,IPL10 JRST MPXTRU .ENTRY PLOTLIST LSUBR 002003 ;LSUBR (1 . 2) PLOTLIST": MOVEI TT,0 AOJE T,PLTL1 AOJN T, [LERR [SIXBIT \WNA - PLOTLIST!\]] POP P,A MOVEI B,.ATOM #1 CALL 2,.FUNCTION GETCHARN MOVE TT,(A) LSH TT,11 PLTL1": TRO TT,767 HRL TT,P PUSHJ P,PLOTC JRST NXP2 UNPLOT": SKIPN A,.SPECIAL PLOT POPJ P, MOVEI TT,F.CHAN ;OTHERWISE CLOSE IPL FILE .CALL MPXCLS .VALUE SETZM .SPECIAL PLOT JRST UNPLOT IPLOPN": PUSH FXP,D MOVEI TT,(SIXBIT \IPL\) PUSHJ P,ALFILE" ;SKIPS IF WIN, LEAVING MPXFLR": LERR [SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\] ;FILE-ARRAY IN A, CHNL NO. IN F MOVEI D,[SIXBIT \IPL\] ;DEVICE NAME MOVEI R,5 ;IMAGE.UNIT.OUTPUT BITS .CALL MPXOPN IOJRST 1,IPL9 MOVEM A,.SPECIAL PLOT POP FXP,D POPJ P, IPL9": POP FXP,TT SUB P,[1,,1] IPL10": JSP T,FIX1A CALL 1,.FUNCTION NCONS MOVEI B,.ATOM PLOT JRST MPXIOL FASEND R PGBOT [RDR] SUBTTL NEW HIRSUTE READER ;;; BITS FOR READTABLE RT.==:RT.BRK\RT$TYP\RT$MTP\777777 ;BIT TYPEOUT MASK RT.BRK==:400000,, ;THIS CHARACTER TERMINATES ATOMS (SIGN BIT!) RT.WVB==:200000,, ;WORTHLESS TO VERTICAL BAR MACRO RT$TYP==:.BP <160000,,> ;TYPE OF CHARACTER RT%FOO==:0 ? RT.FOO==:.DPB RT%FOO,RT$TYP ;WORTHLESS ;TYPES WITH RT.BRK SET RT%OPN==:1 ? RT.LPR==:.DPB RT%LPR,RT$TYP ;OPEN PAREN RT%CLS==:2 ? RT.RPR==:.DPB RT%RPR,RT$TYP ;CLOSE PAREN RT%SPC==:3 ? RT.SPC==:.DPB RT%SPC,RT$TYP ;WHITE SPACE RT%MAC==:4 ? RT.MAC==:.DPB RT%MAC,RT$TYP ;MACRO CHARACTER RT%SCO==:5 ? RT.SCO==:.DPB RT%SCO,RT$TYP ;SINGLE CHAR OBJECT ;TYPES WITH RT.BRK CLEAR RT%ALF==:1 ? RT.ALF==:.DPB RT%ALF,RT$TYP ;ALPHABETIC RT%SLS==:2 ? RT.SLS==:.DPB RT%SLS,RT$TYP ;SLASH RT$NUM==:.BP <017000,,> ;NUMERIC SYNTAX PROPERTY RT%SYM==:0 ? RT.SYM==:.DPB RT%SYM,RT$NUM ;SYMBOL (OR BREAK) RT%DIG==:1 ? RT.DIG==:.DPB RT%DIG,RT$NUM ;DIGIT (0-9) RT%SUP==:2 ? RT.SUP==:.DPB RT%SUP,RT$NUM ;SUPRA-DECIMAL (A-Z) RT%SGN==:3 ? RT.SGN==:.DPB RT%SGN,RT$NUM ;SIGN (+ -) RT%AST==:4 ? RT.AST==:.DPB RT%AST,RT$NUM ;ASTERISK (*) RT%LBR==:5 ? RT.LBR==:.DPB RT%LBR,RT$NUM ;LEFT BRACKET RT%RBR==:6 ? RT.RBR==:.DPB RT%RBR,RT$NUM ;RIGHT BRACKET RT%ARO==:7 ? RT.ARO==:.DPB RT%ARO,RT$NUM ;ARROW (^ _) RT%DOT==:10 ? RT.DOT==:.DPB RT%DOT,RT$NUM ;DOT (.) RT%EXP==:11 ? RT.EXP==:.DPB RT%EXP,RT$NUM ;EXPONENT (E) RT%ROM==:12 ? RT.ROM==:.DPB RT%ROM,RT$NUM ;ROMAN (I V X L C M) RT%XRM==:13 ? RT.XRM==:.DPB RT%XRM,RT$NUM ;ROMAN AND EXPONENT (D) RT$MTP==:.BP <000600,,> ;MACRO TYPE (IF RT$TYP CONTAINS RT%MAC) RT%NRM==:0 ? RT.NRM==:.DPB RT%NRM,RT$MTP ;NORMAL RT%SPL==:1 ? RT.SPL==:.DPB RT%SPL,RT$MTP ;SPLICING RT%LIS==:2 ? RT.LIS==:.DPB RT%LIS,RT$MTP ;LIST RT%LAS==:3 ? RT.LAS==:.DPB RT%LAS,RT$MTP ;LAST ;RIGHT HALF CONTAINS MACRO DEFINITION OR CHTRAN SUBTTL PURE COPY OF THE READER SYNTAX TABLE -1,,0 ;GC POINTER PRCTA: JSP TT,1DIMF ;THIS SHOULD NEVER ACTUALLY BE CALLED NIL 0 ;ACCESS IS ILLEGAL PRCTTT: REPEAT ^G-^@+1, RT.WVB+RT.FOO,,^@+.RPCNT  ;;; ************************************************************** TITLE ***** MACLISP ****** NEWIO VIDISECTOR AND FAKE TV ROUTINES *** ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** .FASL .INSRT SYS:.FASL DEFS VERPRT NVID DEFINE NVDFIL .SPECIAL THE-VIDISECTOR-FILE-OBJECT TERMIN DEFINE BVDFIL .SPECIAL THE-VIDISECTOR-BLOCK-FILE-OBJECT TERMIN DEFINE FTVFIL .SPECIAL THE-FAKE-TV-FILE-OBJECT TERMIN DEFINE FTVU .SPECIAL THE-FAKE-TV-UNIT TERMIN DEFINE FTVBL .SPECIAL THE-FAKE-TV-BUFFER-LIST TERMIN .SXEVAL (SETQ THE-FAKE-TV-UNIT NIL) .SXEVAL (SETQ THE-FAKE-TV-BUFFER-LIST NIL) .ENTRY NVID SUBR 0003 ;SUBR 2 NVID: PUSHJ P,NVIDI ;BREAKS OUT WITH POPJ IF LOSES TLNE TT,3 MOVSI TT,217400 ;16384.0 IN PDP10 MACHINE WORD JRST FLOAT1 NVIDI: SKIPE FTVU ;LEAVES ANSWER IN TT JRST NVIDI2 SKIPN NVDOPD PUSHJ P,NVDOPN NVIDI2: MOVE AR1,A ;GC PROTECT THIS HRR D,B HRL D,A MOVE C,[-1,,D] PUSHJ P,NVDPRE JRST NVIDI3 SKIPN FTVU JRST NVIDI1 HLRE TT,D ;ORDINARY CALL TO FAKETV HRRES D PUSHJ P,FAKETV JRST NVIDI3 POPJ P, NVIDI1: .CALL NVIDI4 .VALUE SETZM NVDOPD .CALL NVIDI5 .VALUE SETZM NVDFIL MOVE TT,D POPJ P, NVIDI4: SETZ SIXBIT \IOT\ ,,NVDCHN 400000,,D NVIDI5: SETZ SIXBIT \CLOSE\ 400000,,NVDCHN NVIDI3: CALL 1,.FUNCTION NCONS MOVEI B,.ATOM NVFIX ;REQUESTED POINTS OUT OF RANGE CALL 2,.FUNCTION XCONS ;ERROR ROUTINE TO PRODUCE ALTERNATIVE SUB P,[1,,1] ;CAUSES BREAK OUT OF NVID OR NVFIX FAC [NON-EXISTENT VIDI POINT!] NVDP4: MOVE F,TT MOVEI R,0 ASHC R,22 DIV R,NVSCL MOVEI TT,0 ASHC TT,22 DIV TT,NVSCL NVDP3: JSP T,FIX1A ;GET A LIST OF THE TWO NUMBERS CALL 1,.FUNCTION NCONS ;([R] [TT]) MOVE B,A MOVE TT,R JSP T,FIX1A JCALL 2,.FUNCTION CONS NVDPRE: JFCL 8.,.+1 HLRZ A,(C) ;PRE-VIDISSECTING PROCESSING JSP T,FXNV1 MOVE R,TT IMUL TT,NVSCL ADDI TT,400000 ;ROUNDING SKIPL TT CAML TT,[40000,,] JRST NVDP1 JFCL 8.,NVDP1 HLLM TT,(C) HRRZ A,(C) JSP T,FXNV1 IMUL TT,NVSCL ADDI TT,400000 SKIPL TT CAML TT,[40000,,] JRST NVDP2 JFCL 8.,NVDP2 HLRM TT,(C) AOBJN C,NVDPRE AOS (P) POPJ P, NVDP1: HRRZ A,(C) NVDP2: JSP T,FXNV1 JRST NVDP3 NVDPST: MOVE TT,(C) ;POST-VIDISSECTING PROCESSING PUSHJ P,NVFX2 MOVEM A,(C) AOBJN C,NVDPST POPJ P, .ENTRY NVFIX SUBR 0003 ;SUBR 2 NVFIX: PUSH P,B PUSH P,A NVFX1: CALL 1,.FUNCTION NUMBERP JUMPE A,NVFXB POP P,A POP P,B PUSHJ P,NVIDI NVFX2: TLNN TT,3 ;DIM CUTOFF, OR COUNTER OVERFLOW TLZA TT,-1 MOVEI TT,40000 ;16384. JRST FIX1 NVDOPN: MOVE T,[SIXBIT \NVD\] PUSHJ P,ALFILE IOL [CAN'T GET I/O CHANNEL FOR NVD!] .CALL NVDOP9 IOL [CAN'T OPEN NVD DEVICE!] MOVEM A,NVDFIL MOVEM F,NVDCHN AOS NVDOPD POPJ P, NVDOP9: SETZ SIXBIT \OPEN\ 4000,,NVDMOD ;MODE BITS ,,F ;CHANNEL # 400000,,[SIXBIT \NVD\] BVDOPN: MOVE T,[SIXBIT \NVD\] PUSHJ P,ALFILE IOL [CAN'T GET I/O CHANNEL FOR BLOCK NVD!] .CALL BVDOP9 IOL [CAN'T OPEN BLOCK NVD DEVICE!] MOVEM A,BVDFIL MOVEM F,BVDCHN AOS BVDOPD POPJ P, BVDOP9: SETZ SIXBIT \OPEN\ 4000,,BVDMOD ;MODE BITS ,,F ;CHANNEL # 400000,,[SIXBIT \NVD\] NVFXB: MOVE A,(P) ;WHOLE BLOCK OF VALUES IN AN ARRAY PUSHJ P,AREGET ;TO BE DISSECTTED PUSH P,A MOVE A,-2(P) JSP T,FXNV1 LOCKI MOVN AR1,TT HRRZ C,(P) HRRZ C,TTSAR(C) HRL C,AR1 ;AOBJN PTR TO ARRAY ENTRIES FOR HACKING MOVE AR1,C ;SAVE IN AR1 PUSHJ P,NVDPRE JRST NVFXE3 SKIPE FTVU JRST NVFXB2 SKIPN BVDOPD PUSHJ P,BVDOPN MOVE C,AR1 .CALL NVFXB8 .VALUE SETZM BVDOPD .CALL NVFXB9 .VALUE NVFXB3: PUSHJ P,NVDPST SUB P,[3,,3] UNLOCKI SETZ A, POPJ P, NVFXB8: SETZ SIXBIT \IOT\ ,,BVDCHN 400000,,AR1 NVFXB9: SETZ SIXBIT \CLOSE\ 400000,,BVDCHN NVFXB2: HRRZ T,AR1 ;UPON ENTRY, CAN USE ARRAY PTR CALCULATED ABOVE HLLZS AR1 ;- IN LH TVFS1: HLRE TT,(T) HRRE D,(T) PUSH FXP,AR1 PUSHJ P,FAKETV ;MIGHT GC ARRAY SPACE JRST NVFXE2 POP FXP,AR1 HRR T,(P) HRR T,TTSAR(T) ADD T,AR1 MOVEM TT,(T) ;PUT BACK VIDI VALUE AOBJN AR1,[AOJA T,TVFS1] SUBI T,-1(AR1) ;RESTORE T TO BE PTR TO ARRAY BEGIN MOVNS AR1 HRL T,AR1 MOVE C,T JRST NVFXB3 NVFXE2: SUB FXP,[1,,1] ;FIX UP PDLS, AND GO TO ERROUT NVFXE3: SUB P,[2,,2] UNLOCKI JRST NVIDI3 ;;; IFN MOBIOF .ENTRY NVSET SUBR 0006 ;SUBR 5 NVSET: PUSH P,AR2A LDB F,[031700,,NVDMOD] NVFIL: JUMPE A,NVCONF JSP T,FXNV1 DPB TT,[100200,,F] TRNN TT,4 TRZA F,10_10 TRO F,10_10 NVCONF: JUMPE B,NVRES JSP T,FXNV2 MOVEM D,NVCFL DPB D,[000200,,F] NVRES: JUMPE C,NVDIM JSP T,FXNV3 HRLZI T,40000 IDIVM T,R MOVEM R,NVSCL NVDIM: JUMPE AR1,NVXYZ MOVE A,AR1 JSP T,FXNV1 MOVEM TT,NVDCL DPB TT,[020300,,F] NVXYZ: POP P,A JUMPE A,NVST1 JSP T,FXNV1 JUMPN TT,.+2 TRZA F,340 TRO F,340 NVST1: DPB F,[031700,,NVDMOD] DPB F,[031700,,BVDMOD] SETZM NVDOPD PUSH P,[0] MOVE TT,NVCFL JSP T,FXCONS PUSH P,A HRLZI TT,40000 IDIV TT,NVSCL JSP T,FIX1A PUSH P,A MOVE TT,NVDCL JSP T,FXCONS PUSH P,A PUSH P,[0] MOVNI T,5 JCALL 16,.FUNCTION LIST SUBTTL FAKE TV STUFF ;FUNCTIONS THAT ALLOW READING VIDISECTOR VALUES ; FROM A STORED IMAGE SUBSIZ==64. ;SUB-PICTURE SIZE VIDIS==4. ;NUMBER OF VIDI VALUES PER WORD XWRDS==SUBSIZ/VIDIS WRDBLK==SUBSIZ*XWRDS ;NUMBER WORDS IN A SUB-PICTURE FRESL==16. ;STORED IMAGE HAS 1 OUT OF EVERY 16. POINTS HFRESL==8. .ENTRY SFTV| SUBR 0006 ;SUBR 5 CAIG AR2A,4 CAIGE AR2A,0 .VALUE JRST @.+1(AR2A) SFTV SSFTV SFTVSIZE SSFTVSIZE SFTVTITLE ;THIS CODE SETS UP THE MAXIMUM NUMBER OF BUFFERS USED BEFORE ;PAGING OUT ONE BLOCK AND READING ANOTHER IN OVER ITS BUFFER SSFTVSIZE: JSP T,FXNV1 MOVEM TT,MFTVBL MOVEI A,.ATOM T POP P, SFTVSIZE: MOVE TT,MFTVBL JRST FIX1 FKTV2A: SUB FXP,[2,,2] ADD TT,XLL ADD TT+1,YLL FKTV4: PUSHJ P,NVDP4 JRST FTVX ;NO SKIP IF POINTS OUT OF RANGE ;THIS ROUTINE WILL READ A VIDI VALUE FROM THE STORED IMAGE ; OPENED BY FTVOPN ; TT=X POSITION (OUT OF 16384.) ; D=Y POSITION FAKETV: LOCKI CAML TT,XLL CAMLE TT,XUR JRST FKTV4 ;NO SKIP IF POINTS OUT OF RANGE CAML TT+1,YLL CAMLE TT+1,YUR JRST FKTV4 ;NO SKIP IF POINTS OUT OF RANGE SUB TT,XLL SUB TT+1,YLL MOVE A,TT IDIVI A,FRESL CAIL B,HFRESL AOS A ;CONVERT TO 1024. POINT FRAME SIZE MOVE B,TT+1 IDIVI B,FRESL CAIL C,HFRESL AOS B IDIVI B,SUBSIZ ;COMPUTE BLOCK NUMBER THAT CONTAINS POINT PUSH FXP,C IMUL B,XBLOKS EXCH A,B IDIVI B,SUBSIZ PUSH FXP,C ADDI A,1(B) ;MUST HAVE FEWER THAN 2_18. BLOKS CAMN A,CURBLK ;IS IT THE CURRENT BLOCK? JRST FKTV1 ;YUP CAMLE A,NBLOKS ;IS IT A REAL BLOCK? JRST FKTV2A PUSH FXP,A PUSHJ P,FTGTBF POP FXP,A JUMPN B,FKTV1 ;IF BLOCK FOUND ON BLOKLIST, GO FTV1 IMULI A,WRDBLK ;IF NOT, THEN BUFFER IS READY FOR IOT INTO IT .CALL FKTV8 ;GO TO BEGINNING OF DISK BLOCK .VALUE MOVNI A,WRDBLK HRLZS A HRR A,BUFFER HRR A,TTSAR(A) .CALL FKTV9 ;AND READ IT INTO CORE .VALUE FKTV1: MOVE B,NVDCL ;GET CURRENT DCL CAMN B,ODCL JRST FKTV3 ;NO CHANGE MOVEM B,ODCL ;SET NEW LEVEL SKIPE B CAIN B,7 MOVEI B,1 IMULI B,100 MOVNS B ADDI B,1300 MOVEM B,NVDK ;COMPUTE NEW DIM CUTOFF VALUE FKTV3: POP FXP,B POP FXP,C VIDGET: HRRZ A,BUFFER ;THIS ROUTINE GETS A VIDI VALUE HRRZ A,TTSAR(A) ;FROM THE CURRENT BLOCK IMULI C,XWRDS ;B=X POSITION IN BLOCK ADD A,C ;C=Y POSITION IN BLOCK IDIVI B,VIDIS ADD A,B ;ADDRESS OF WORD CONTAINING DESIRED BYTE SUBI C,3 MOVMS C IMULI C,110000 ;COMPUTE BYTE POINTER ADDI C,1100 ;9 BITS PER BYTE HRL A,C LDB A,A ;GET BYTE ADDI A,201 CAMLE A,NVDK MOVE A,NVDK ;DIM CUTOFF HACK LDB B,[60600,,A] ;RECREATE VIDI WORD FORMAT ADDI B,224 MOVE C,A TRZ C,777700 ;GET RID OF EXPONENT ADDI C,100 FSC C,(B) HLL A,C MOVE TT,A SETZB A,AR1 AOS (P) ;NORMAL EXIT FROM FAKETV SKIPS ONE JRST FTVX FKTV8: SETZ SIXBIT \ACCESS\ ,,FTVCHN 400000,,A FKTV9: SETZ SIXBIT \IOT\ ,,FTVCHN 400000,,A ;HERE WE GET THE TITLE ON THE FAKE TV FILE SFTVTITLE: SKIPN A,FTVU POPJ P, SKIPE CURBLK ;HEADER FOR FAKETV PUSHJ P,PINIT ;MAKE SURE BLOCK 0 IS CURRENT LOCKTOPOPJ HRRZ R,BUFFER ;SAR WORD IN TT+2 HRRZ R,TTSAR(R) SETZ A, SKIPN 3(R) ;GET HEADER DESCRIPTION AS LIST POPJ P, ADDI R,3 HRLI R,440700 MOVEM R,FTVBP MOVEI A,SFTIT SETZ B, JRST READ0A SFTIT: ILDB A,FTVBP POPJ P, PINIT: PUSH P,FTVU ;MAKE SURE BLOCK ZERO IS CURRENT LOCKI JRST SSFTV1 SSFTV: PUSHJ P,FTVOPN SFTV: SKIPN A,FTVU POPJ P, MOVE TT,XLL MOVE TT+1,YLL PUSHJ P,NVDP4 MOVE C,A MOVE TT,XUR MOVE TT+1,YUR PUSHJ P,NVDP4 MOVE B,FTVU CALL 2,.FUNCTION CONS MOVE B,C JCALL 2,.FUNCTION XCONS ;;; THIS FUNCTION OPENS THE IMAGE FILE AND COMPUTES SOME NEEDED VALUES FTOPNER: UNLOCKI POP P,A MOVEI B,.ATOM UREAD CALL 2,.FUNCTION XCONS FAC [TV FILE NOT FOUND!] FTVOPN: SETZM FTVU SETZM FTVBL SETZM NFTVBL JUMPE A,CPOPJ HRRZ T,(A) JUMPE T,CPOPJ CALL 1,.FUNCTION DEFAULTF PUSH P,A PUSHJ P,FIL6BT REPEAT 4, POP FXP,FTVFNM+3-.RPCNT MOVE TT,FTVFNM PUSHJ P,ALFILE IOL [CAN'T GET I/O CHANNEL FOR FAKE TV!] MOVEM F,FTVCHN MOVEM A,FTVFIL SSFTV1: MOVEI A,0 PUSHJ P,FTGTBF ;GET A BUFFER REGION FOR BLOCK 0 JUMPN B,POP1J ;FINDABLE ONLY ON NON-INITIAL TRIES .CALL FTVX8 JRST FTOPNER POP P,FTVU SETZM CURBLK SETOM ODCL ;FORCE RECOMPUTATION OF DIM CUTOFF VALUE HRRZ A,BUFFER ;FIRST TIME THRU FAKETV HRRZ A,TTSAR(A) HRLI A,-2000 .CALL FTVX9 ;READ HEADER .VALUE HRRZ B,BUFFER ;XLL,,YLL HRRZ B,TTSAR(B) MOVE A,(B) HLRZM A,XLL HRRZM A,YLL MOVE A,1(B) ;XUR,,YUR HLRZM A,XUR HRRZM A,YUR MOVE A,XUR SUB A,XLL IDIVI A,SUBSIZ*FRESL SKIPE B AOS A ;ROUND OFF MOVEM A,XBLOKS MOVE A,YUR SUB A,YLL IDIVI A,SUBSIZ*FRESL SKIPE B AOS A MOVEM A,YBLOKS IMUL A,XBLOKS MOVEM A,NBLOKS ;NUMBER OF SUB-PICTURES IN FILE FTVX: SETZB B,C UNLKPOPJ FTVX8: SETZ SIXBIT \OPEN\ 5000,,6 ,,FTVCHN ,,FTVFNM ,,FTVFNM+2 ,,FTVFNM+3 400000,,FTVFNM+1 FTVX9: SETZ SIXBIT \IOT\ ,,FTVCHN 400000,,A FTGTBF: PUSH P,A ;BLOCK NO. IN A HRRZ B,FTVBL ;ALLOCATE A BUFFER AREA, JUMPE B,FTGBF2 CALL 2,.FUNCTION ASSQ JRST FTGBF1 ;SIGNAL IF DESIRED BLOCK IS FOUND MOVEI B,.ATOM T ;AND IS IN BUFFER AREA FTGBF3: HRRZ A,(A) ;MAKE THE FOUND ENTRY CURRENT MOVEM A,BUFFER POP P,CURBLK POPJ P, FTGBF1: MOVE T,MFTVBL ;SO GRAB BUFFER AT FRONT OF QUEUE CAMLE T,NFTVBL ;BRING TO END OF QUEUE, AND USE JRST FTGBF2 ;IT FOR STORAGE OF DESIRED BLOCK CAIG T,200 CAIGE T,1 JRST FTGBF6 MOVE A,FTVBL HRRZ B,(A) HLLOS NOQUIT HRRM B,FTVBL ;CDR THE BLOCKS LIST HLLZS (A) HLRZ B,A ;POINTER TO CURRENT END OF BLOCKS LIST HRRM A,(B) ;LIST IS NOW ROTATED ONE HRLM A,FTVBL ;UPDATE POINTER TO END OF LIST HLRZ A,(A) MOVE B,(P) ;ROTATED BUFFER IS GRABBED FOR DESIRED BLOCK HRLM B,(A) FTGBF4: HLLZS NOQUIT PUSHJ P,CHECKI MOVEI B,NIL ;SIGNAL THAT DESIRED BLOCK NOT IN CORE YET JRST FTGBF3 ;BUT A BUFFER HAS BEEN SET UP FOR IT FTGBF6: MOVEI T,4 MOVEM T,MFTVBL FTGBF2: PUSH P,[FTGBF7] PUSH P,[NIL] PUSH P,[.ATOM FIXNUM ] PUSH P,[.ATOM #2000 ] MOVNI T,3 JCALL 16,.FUNCTION *ARRAY FTGBF7: MOVE A,(P) CALL 2,.FUNCTION CONS CALL 1,.FUNCTION NCONS ;STRUCTURE OF BLOCKS LIST IS DOTTED PAIRS HLRZ B,FTVBL ;WITH BLOCK NO. IN LH, ADDRESS OF SAR HLLOS NOQUIT ;FOR BUFFER IN RH HRLM A,FTVBL SKIPN B MOVEI B,FTVBL HRRM A,(B) ;SPLICE IN NEW ENTRY AT LAST OF LIST HLRZ A,(A) AOS NFTVBL ;INFORM THAT ONE MORE BLOCK HAS BEEN TAKEN JRST FTGBF4 ;;; REGION OF IMPURE VARIABLES!!! NVDCHN: 0 ;NVD CHANNEL NUMBER BVDCHN: 0 ;BVD CHANNEL NUMBER NVDMOD: 0 ;NVD MODE BVDMOD: 2 ;BVD MODE NVDOPD: 0 ;NVD OPEN FLAG BVDOPD: 0 ;BVD OPEN FLAG NVSCL: 20,, ;SCALING FOR NVFIX - NORMALLY CONVERTS 0 - 37777 TO 0 1777 FTVCHN: 0 ;FAKE TV CHANNEL FTVFNM: BLOCK 4 ;FAKE TV FILE NAMES CURBLK: 0 ;NUMBER OF BLOCK STORED IN ARRAY POINTED TO BY BUFFER BUFFER: 0 ;POINTER TO SAR OF BUFFER ARRAY NFTVBL: 0 ;CURRENT NUMBER OF BLOCKS IN CORE MFTVBL: 4 ;MAX ALLOWABLE, BEFORE DELETIONS OF BLOCKS IN CORE OCCURS XBLOKS: 0 YBLOKS: 0 NBLOKS: 0 ;TOTAL NUMBER OF BLOCKS XLL: 0 YLL: 0 ;Y " XUR: 0 ;X UPPER-RIGHT YUR: 0 ;Y " FTVBP: 0 ;BYTE PTR FOR FTVTITLE NVDCL: 0 ;DIM CUTOFF LEVL NVCFL: 0 ;CONFIDENCE LEVEL OF IMAGE NVDK: 0 ;DIM CUTOFF ON FAKETV ODCL: 0 ;LAST DIM CUTOFF ON FAKETV FASEND s;;; STORAGE LAYOUT FOR ITS BIBOP ;;; ;;; 0 LOW PAGES ;;; ACCUMULATORS, TEMPORARY VARIABLES, ;;; INITIAL READTABLE AND OBARRAY ;;; BSYSSG INITIAL SYSTEM CODE (PURE) ;;; BSARSG INITIAL SAR SPACE ;;; BVCSG INITIAL VALUE CELL SPACE ;;; ... INITIAL LIST STRUCTURE ... ;;; ST SEGMENT TABLES ;;; BBITSG BIT BLOCKS FOR GC ;;; BBPSSG START OF BINARY PROGRAM SPACE ;;; (ALLOC IS IN THIS AREA) ;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS ;;; V(BPEND) ARRAYS START NO LOWER THAN THIS ;;; C(BPSH) LAST WORD OF BPS ;;; ... BINARY PROGRAM SPACE GROWS UPWARD ... ;;; C(HINXM) LAST WORD OF GROSS HOLE IN MEMORY ;;; ... LIST STRUCTURE GROWS DOWNWARD ... ;;; PUSHDOWN LISTS WITH HOLES BETWEEN: ;;; FXP, FLP, P, SP ;;; ;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP) ;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP) ;;; ;;; PATCH AREA IS IN SYSTEM PAGE WITH MOST ROOM ;;; STORAGE LAYOUT FOR DEC10 BIBOP ;;; ;;; ***** LOW SEGMENT ***** ;;; 0 LOW PAGES ;;; ACCUMULATORS, TEMPORARY VARIABLES, ;;; INITIAL READTABLE AND OBARRAY ;;; ST SEGMENT TABLES ;;; PATCH PATCH AREA ;;; BSARSG INITIAL SAR SPACE ;;; BVCSG INITIAL VALUE CELL SPACE ;;; ... INITIAL IMPURE LIST STRUCTURE ... ;;; BBITSG BIT BLOCKS FOR GC ;;; BBPSSG START OF BINARY PROGRAM SPACE ;;; (ALLOC IS IN THIS AREA) ;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS ;;; V(BPEND) ARRAYS START NO LOWER THAN THIS ;;; C(BPSH) LAST WORD OF BPS (FIXED, SET BY ALLOC) ;;; PUSHDOWN LISTS: ;;; FXP, FLP, P, SP ;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP) ;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP) ;;; C(LONXM) LOW WORD OF HOLE IN MEMORY ABOVE LOW SEGMENT ;;; MAXNXM HIGHEST WORD OF NXM THAT MAY BE USED ;;; ;;; ***** HIGH SEGMENT ***** ;;; BSYSSG INITIAL SYSTEM CODE (PURE) ;;; BPFSSG INITIAL PURE LIST STRUCTURE  ;;; -*-MIDAS-*- ;;; ************************************************************** ;;; ***** MACLISP ****** KLUDGY BINFORD EDITOR ******************* ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1979 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** SUBTTL KLUDGY BINFORD EDITOR EDPRW==13 ;PRINT WIDTH,PRINT N ATOMS ON ;EITHER SIDE OF POINTER R4==AR1 R5==AR2A R6==T $EDIT: MOVE B,A JSP T,RSXST JSP D,BRGEN ;ERRSET LOOP JUMPE B,EDTTY HLRZ A,(B) JSP T,SPATOM JRST EDERRC PUSH P,CEDTTY JRST EDY0 EDTTY: SKIPE EDPRFL PUSHJ P,EDPRINT EDTTY4: MOVEI C,0 ;INIT NUMBER MOVEI B,0 ;INIT SYMBOL,NUMBERS COME HERE MOVE R4,[220600,,B] ;SETUP BYTEP EDTYIN: SETZM BFPRDP PUSH P,R4 ;ALIAS AR1, WHICH TYI CLOBBERS PUSHJ P,TYI POP P,R4 MOVE R5,@RSXTB NW% TLNN R5,4 NW$ TRNN R5,RS.DIG JRST EDTTY1 ;NOT NUMBER EDNUM: IMULI C,10. ;ACCUMULATE DECIMAL NUMBER NW% ADDI C,-"0(R5) NW$ ANDI R5,777 NW$ ADDI C,-"0(R5) JRST EDTYIN EDTTY1: CAIE A,15 CAIN A,12 JRST EDTYIN CAIE A,33 CAIN A,177 JRST EDTTY3 CAIN A,40 JRST EDTTY2 NW% TLNN R5,377777 NW$ TDNN R5,[001377777000] ;?? JRST EDTYIN NW% TLNN R5,70053 ;LEGIT CHARS ARE ( ) - , . NW$ TDNN R5,[RS.LTR+RS.XLT+RS.LP+RS.RP+RS.DOT+RS.SGN+RS.ALT] ;RS.ALT?? JRST EDERRC ADDI R5,40 TLNE R4,770000 ;SIXBIT THREE CHARS IDPB R5,R4 JRST EDTYIN ;READ NEXT CHAR EDTTY2: JUMPE B,EDTYIN ;IGNORE LEADING SPACES PUSHJ P,EDSYM JRST EDTTY EDTTY3: SKIPE EDPRFL STRT [SIXBIT \^M $$ ^M!\] JRST EDTTY4 ;SEARCH SYMBOL TABLE EDSYM: MOVEI R5,EDSYML-1 EDSYM1: MOVS R6,EDSYMT(R5) CAIE B,(R6) SOJGE R5,EDSYM1 JUMPL R5,EDSYM3 EDEXEC: HLRZM R6,EDEX2 ;GET COMMAND ADDRESS CAIL R5,EDRPT JRST @EDEX2 ;NO REPEAT ON THESE COMMANDS EDEX1: PUSH P,C PUSHJ P,@EDEX2 ;EXECUTE COMMAND SOSLE C,(P) JUMPN A,.-2 EDEX3: JRST POPBJ EDSYM3: PUSH FXP,C MOVE C,[440700,,PNBUF] MOVE R4,[440600,,B] MOVSI B,(B) SETOM LPNF SETZM PNBUF JRST EDSYM5 EDSYM4: ADDI A,40 IDPB A,C EDSYM5: ILDB A,R4 JUMPN A,EDSYM4 PUSHJ P,RINTERN MOVEI B,Q$EDIT PUSHJ P,GET POP FXP,TT JUMPE A,EDERRC MOVEI AR1,(A) JSP T,FXCONS JCALLF 1,(AR1) EDERRC: STRT [SIXBIT \?? !\] CEDTTY: JRST EDTTY EDSYMT: ;COMMAND TABLE EDSYMB: +(SIXBIT \B\),,EDB ;BACK,LEFT PAST ATOM +(SIXBIT \D\),,EDDOWN ;DOWN EDSYMF: +(SIXBIT \F\),,EDF ;FORWARD,RIGHT ATOM +(SIXBIT \U\),,EDUP ;UP +(SIXBIT \L\),,EDLL ;LEFT PAST S-EXPR +(SIXBIT \R\),,EDRR ;RIGHT PAST S-EXPR +(SIXBIT \K\),,EDKILL ;KILL +(SIXBIT \-K\),,EDLKILL ;LEFT, THEN KILL +(SIXBIT \-L\),,EDRR +(SIXBIT \-R\),,EDLL +(SIXBIT \PW\),,EDPW ;SET PRINT WIDTH EDSYMP: +(SIXBIT \PQ\),,EDPRA ;INTERNAL PRINT +(SIXBIT \EV\),,REP ;EVAL +(SIXBIT \I\),,EDI ;INSERT +(SIXBIT \KI\),,EDKI ;REPLACE,I E KILL INSERT +(SIXBIT \-KI\),,EDMKI ;REPLACE TO LEFT +(SIXBIT \IV\),,EDIV ;INSERT VALUE OF ARG +(SIXBIT \P\),,EDPR0 ;PRINT +(SIXBIT \Q\),,EDQ ;QUIT,EXIT FROM EDIT +(SIXBIT \S\),,EDS ;SEARCH +(SIXBIT \SS\),,EDSAVE ;SAVE SPOT +(SIXBIT \RS\),,EDRSTR ;RESTORE SPOT +(SIXBIT \SP\),,EDCHPR ;START-PRINTING (OR STOP-PRINTING) +(SIXBIT \J\),,EDTOP ;TOP +(SIXBIT \Y\),,EDY ;YANK +(SIXBIT \YP\),,EDYP ;YANK PROP LIST, OR SPECIFIC PROPERTY +(SIXBIT \YV\),,EDYV ;YANK VALUE +(SIXBIT \(\),,EDLP. ;INSERT VIRTUAL LEFT PAREN +(SIXBIT \)\),,EDRP. ;INSERT VIRTUAL RIGHT PAREN +(SIXBIT \D(\),,EDXLP ;VIRTUAL DELETION OF PAREN +(SIXBIT \D)\),,EDXLP ;VIRTUAL DELETION OF PAREN +(SIXBIT \()\),,EDZZ ;RESTRUCTURE ACCORDING TO VIRTUAL PARENS EDSYML==.-EDSYMT EDRPT==EDSYMP+1-EDSYMT ;NO REPEAT FOR COMMANDS ABOVE EDSYMP ;EDIT MANIPULATES TWO LISTS FOR BACKING UP ;THE LEFT LIST CALLED L (VALUE OF $$$ (3 ALTMODES)) ;RIGHT: (COND ((PTR (CAR L)) (SETQ L (CONS (CDAR L) L)))) ;LEFT: (COND ((PTR L) (SETQ L (CDR L)))) ;THE UP LIST U (KEPT AT EDUPLST) ;DOWN: (COND ((AND (PTR (CAR L)) (PTR (CAAR L))) ; (SETQ U (CONS L U)) ; (SETQ L (LIST L)))) ;UP: (COND ((PTR U) (SETQ L (CAR U)) ; (SETQ U (CDR U)))) EDQ: MOVEI A,Q. MOVEI B,QBREAK JRST THROW1 ;THROW OUT OF BREAK ERRSET LOOP ;RIGHT PAST S-EXPR ;USES ONLY A,B ;NIL IF FAILS EDR: PUSHJ P,EDCAR JRST FALSE ;NOT A PTR HRRZ A,(A) ;TAKE CDAR L HRRZ B,VDLDLDL PUSHJ P,CONS ;CONS ONTO L EDR1: HRRZM A,VDLDLDL ;STORE IN L POPJ P, ;NON-ZERO,VALUE EDIT EDLEFT: SKIPE A,VDLDLDL ;TAKE CDR IF NON-NIL HRRZ A,(A) JUMPE A,FALSE JRST EDR1 ;DOWN ONE LEVEL ;USES ONLY A,B ;NIL IN A IF FAILS EDDOWN: PUSHJ P,EDCAAR ;IS (CAAR L) A PTR JRST FALSE ;NOT PTR PUSHJ P,NCONS EXCH A,VDLDLDL ;STORE IN L HRRZ B,EDUPLST PUSHJ P,CONS ;CONS L U EDD1: HRRZM A,EDUPLST ;STORE IN U POPJ P, ;NON-ZERO ;BACK EDB: PUSHJ P,EDLEFT ;LEFT? JUMPE A,EDUP PUSHJ P,EDCAAR ;NEXT IS ATOM? JRST TRUE EDB1: PUSHJ P,EDDOWN ;DOWN JUMPE A,EDUP EDXR: PUSHJ P,EDR ;EXTREME RIGHT JUMPN A,.-1 JRST TRUE ;FORWARD ;RIGHT ATOM EDF: PUSHJ P,EDCAR ;CAR L PTR? JRST EDF2 ;NOT PTR PUSHJ P,EDCAR1 ;(CAAR L) ATOM JRST EDR ;ATOM,GO RIGHT EDF1: PUSHJ P,EDDOWN ;DOWN? JUMPN A,CPOPJ EDF2: PUSHJ P,EDUP ;UP? JUMPN A,EDR ;AND RIGHT?OTHERWISE FALLS THROUGH TO EDUP EDUP: SKIPN A,EDUPLST ;UP ONE LEVEL JRST FALSE MOVE A,(A) JUMPE A,FALSE HLRZM A,VDLDLDL ;L=(CAR U) JRST EDD1 EDRR: PUSHJ P,EDR JUMPN A,CPOPJ JRST EDF EDLL: PUSHJ P,EDLEFT JUMPN A,CPOPJ JRST EDUP REP: PUSHJ P,IREAD PUSHJ P,EVAL JRST TLPRINT EDPR0: SKIPE EDPRFL POPJ P, EDPRINT: PUSH P,VDLDLDL PUSH P,EDUPLST ;SAVE CURRENT LOCATION PUSHJ P,TERPRI MOVN C,EDPRN ;ATOM COUNT PUSHJ P,EDB ;MOVE BACK N TOKENS JUMPE A,.+2 AOJL C,.-2 ADD C,EDPRN ;PRINT FORWARD 2N ATOMS ADD C,EDPRN MOVEI T,EDPRA MOVEM T,EDEX2 SKIPE EDPRN PUSHJ P,EDEX1 PUSHJ P,TERPRI EDPRX: POP P,EDUPLST ;RESTORE CURRENT LOCATION POP P,VDLDLDL POPJ P, EDPRA: MOVSI T,400000 CAME C,EDPRN ;CURRENT LOCATION? JRST .+3 STRT [SIXBIT \ $$ !\] ;PRINT ** CURSOR ANDCAM T,EDEX2 SKIPN A,VDLDLDL JRST EDF ;EXIT IF NOTHING MORE PUSH P,.-1 ;PRINT ONE TOKEN AND MOVE FORWARD PUSHJ P,EDCAR1 ;(CAR L) A PTR JRST EDPRG SKIPGE EDEX2 ;OUTPUT A SPACE IF PREVIOUS EDPRA STRT [SIXBIT \ !\] ; CALL REQUESTED IT IORM T,EDEX2 ;ASSUMING NEXT IS ATOM, ASK FOR SPACE PUSHJ P,EDCAR1 JRST IPRIN1 ;(CAAR L) IS ATOM, SO PRIN1 IT ANDCAM T,EDEX2 ;IF NOT, REVOKE REQUEST FOR NEXT SPACE MOVEI A,"( ;AND BEGIN PRINTING A LIST JRST TYO EDPRG: IORM T,EDEX2 ;SINCE THIS SECTIONS ENDS BY PRINTING JUMPE A,EDPRG1 ;A ")", THEN REQUEST SPACE ON NEXT STRT [SIXBIT \ . !\] PUSHJ P,IPRIN1 EDPRG1: MOVEI A,") JRST TYO EDSAVE: PUSHJ P,READ ;SAVE CURRENT EDITING SPOT AS THE VALUE OF SOME ATOM SKIPN AR1,A JRST EDERRC PUSHJ P,TYPEP CAIE A,QSYMBOL JRST EDERRC MOVE A,VDLDLDL MOVE B,EDUPLST PUSHJ P,CONS JSP T,.SET POPJ P, EDRSTR: PUSHJ P,READ ;SET CURRENT EDITINT SPOT TO THAT SAVED UP IN SOME ATOM PUSHJ P,EVAL HLRZ B,(A) MOVEM B,VDLDLDL HRRZ A,(A) MOVEM A,EDUPLST POPJ P, EDCHPR: SETCMM EDPRFL POPJ P, EDPW: MOVEM C,EDPRN ;SET PRINT WIDTH MOVEI A,NIL JRST POPJ1 EDCAAR: PUSHJ P,EDCAR EDCAR: SKIPE A,VDLDLDL EDCAR1: HLRZ A,(A) ;MUST PRESERVE T FOR EDPRA SKIPN TT,A POPJ P, LSH TT,-SEGLOG SKIPGE ST(TT) AOS (P) POPJ P, ;INSERT:(SETQ L2(CAR L)) ; (COND((LEFT)(RPLACD(CAR L)(CONS I L2)) ; (RIGHT)(RIGHT)) ; ((UP)(RPLACA(CAR L)(CONS I L2)) ; (DOWN)(RIGHT))) ;KILL:(SETQ L2(CAR L)) ; (COND((LEFT)(RPLACD(CAR L)(CDR L)) ; (RIGHT)) ; ((UP)(RPLACA(CAR L)(CDR L2)) ; (DOWN))) ;INSERT ONE S-EXPR ;USES A,B AND WHATEVER READ SMASHES EDI: PUSHJ P,EDREAD ;GET S-EXPR EDIB: MOVEI D,EDIA JRST EDMAP EDIV: PUSHJ P,READ PUSHJ P,EVAL MOVE B,A EDIA: SKIPE A,VDLDLDL HLRZ A,(A) EDIC: PUSHJ P,XCONS MOVE B,A EDID: PUSHJ P,EDK1 JRST EDR EDLKILL: PUSHJ P,EDLEFT JUMPE A,CPOPJ EDKILL: EDKA: PUSHJ P,EDCAR ;KILL ONE S-EXP SKIPA B,A ;USES A,B HRRZ B,(A) HLRZ A,(A) HRRZM A,VDOLLAR EDK1: PUSHJ P,EDLEFT ;LEFT? JUMPE A,EDI2 PUSHJ P,EDCAR JRST EDI2 HRRM B,(A) ;(RPLACD (CAR L) Q) EDK2: JRST EDR ;RETURNS NIL IF FAILS EDI2: PUSHJ P,EDUP ;UP? JUMPE A,FALSE PUSHJ P,EDCAR ;IS (CAR L) POINTER JRST FALSE HRLM B,(A) ;(RPLACA (CAR L) Q) EDI3: JRST EDDOWN EDRDATOM: PUSHJ P,READ MOVE B,A PUSHJ P,ATOM JUMPN A,SPROG2 JRST EDERRC EDY: PUSHJ P,EDRDATOM EDY0: MOVE B,V$EDIT PUSHJ P,GETLA JUMPE A,EDERRC EDYX: PUSHJ P,NCONS EDYX1: SETZM EDUPLST JRST EDR1 EDYV: PUSHJ P,EDRDATOM MOVEI B,QVALUE JRST EDY2A EDYP: PUSHJ P,EDREAD HRRZ B,(A) JUMPE B,EDY1 HLRZ A,(A) EDY2: HLRZ B,(B) EDY2A: MOVEI C,(B) PUSHJ P,GET CAIE C,QVALUE JRST EDYX HRRZ A,(A) CAIN A,QUNBOUND JRST EDERRC JRST EDYX EDY1: HLRZ A,(A) ;GET ATOM READ HRRZ A,(A) ;GET ITS PLIST JRST EDYX ;READS A STRING OF S-EXPRS TERM BY  ;FORMS A LIST IN PROPER DIRECTION EDREAD: PUSHJ P,IREAD ;GET S-EXPR CAIN A,DOLLAR ;$$ TERMINATES JRST FALSE PUSH P,A PUSHJ P,EDREAD ;FORM LIST BY RECURSION JRST SUBS3 ;SEARCH ;PERMITS SEARCH FOR FRAGMENTS OF AN ;S-EXPR. FORMATS 3S A B C  ;3S A B C /) $$ OR S /( X Y Z  EDS: PUSH P,VDLDLDL PUSH P,EDUPLST ;SAVE ORIGINAL LOCATION PUSH P,C ;SAVE COUNT PUSHJ P,EDREAD ;READ STRING OF S-EXPRS JUMPN A,.+2 SKIPA A,EDSRCH MOVEM A,EDSRCH PUSH P,A ;SAVE READ LIST EDS1: PUSH P,VDLDLDL PUSH P,EDUPLST EDS11: MOVE A,-2(P) ;ARG IN B MOVEI D,EDS3 PUSHJ P,EDMAP ;DOES CURRENT LOC MATCH? JUMPN A,EDSN ;WE HAVE A MATCH EDS1A: POP P,EDUPLST POP P,VDLDLDL PUSHJ P,EDF ;NO MATCH,GO RIGHT ATOM JUMPN A,EDS1 ;FINISHED,SEARCH FAILS EDSF: SUB P,R70+2 JRST EDPRX ;EXIT RESTORE ORIG LOC EDSN: SOSLE -3(P) ;DECREMENT COUNT JRST EDS11 ;NOT FININSHED,MATCH AGAIN SUB P,R70+6 ;RESTORE PDL JRST FALSE ;TO AVOID REPEATS BY EDEV ;TEST CURRENT LOCATION ;A IS QUANTITY TO TEST ;(CAR L) IS THE CURRENT LIST ;(COND ; ((NULL(PTR(CAR L))) ; (COND((EQ A(QUOTE /) ))(RIGHTA)))) ; ((NULL(PTR(CAAR L))) ; (COND((EQ A(CAAR L))(RIGHTA)))) ; ((EQUAL A(CAAR L))(RIGHT)) ; ((EQ A(QUOTE /())(RIGHTA))) ;TEST CURRENT LOCATION ;ARG A IS IN B EDS3: PUSHJ P,EDCAR ;IS(CAR L)POINTER JRST FALSE HLRZ A,(A) PUSHJ P,EQUAL ;(EQUAL A(CAAR L)) JUMPE A,FALSE JRST EDR ;MAP DOWN LIST EDMAP: MOVE R,A EDMAP2: JUMPE R,TRUE HLRZ B,(R) ;TAKE CAR PUSHJ P,(D) ;FUNARG JUMPE A,CPOPJ ;MATCH FAILS HRRZ R,(R) JRST EDMAP2 EDTOP: MOVEI C,100000 HLRZ B,EDSYMB JRST EDSYM EDMKI: PUSHJ P,EDLEFT JUMPE A,CPOPJ EDKI: PUSHJ P,READ EDKI1: MOVE B,A PUSHJ P,EDCAR ;IF PTR IS ATOM RPLACD JRST EDID ; HRRZ C,(A) ;I THINK THESE SCREW UP TOTALLY - GLS ; HLRZ C,(C) ; HRRZM C,VDLDLDL HRLM B,(A) ;RPLACA JRST EDR ; ;(CAAR L) ATOM MATCH ONLY (EQ A(CAAR L)) ;EDS3B: CAME A,B ; JRST FALSE ; JRST EDR ; ;CURRENT LIST FINISHED,CAN ONLY MATCH /) ;EDS3A: JUMPN A,EDS3B ; CAIN B,RPAREN ; JRST EDF ; JRST FALSE ;EDIP: PUSHJ P,EDCAR ;INSERT PARENS ; JUMPN A,FALSE ;AROUND NEXT ELEMENT ; HLRZ A,(A) ; PUSHJ P,NCONS ; JRST EDKI1 ; ;EDDP: PUSHJ P,EDCAAR ;DELETE PARENS ; JRST FALSE ; PUSHJ P,EDIB ; JRST EDKA EDRP.: SKIPA B,CEDRP EDLP.: MOVEI B,EDLP ;INSERT VIRTUAL LEFT PAREN JRST EDIA EDXLP: MOVEI B,EDSTAR ;INSERT CHAR TO DELETE NEXT PAREN JRST EDIA EDZZ: PUSHJ P,EDTOP ;RESTRUCTURE W/ VIRTUAL PARENS PUSHJ P,EDF PUSHJ P,EDXA PUSH P,A PUSHJ P,EDTOP PUSHJ P,EDF POP P,A JRST EDKI1 EDXE: SKIPE A,EDUPLST PUSHJ P,EDF EDXZ: SKIPE A,EDUPLST EDXA: PUSHJ P,EDF ;FORWARD EDXX: SKIPE A,EDUPLST PUSHJ P,EDCAR ;(PTR(CAR L)) POPJ P, ;ATOM(CAR L) HLRZ B,(A) ;(CAAR L) CEDRP: CAIN B,EDRP ;IS IS /)? JRST FALSE ;SKIP AND RETURN FALSE CAIN B,EDSTAR JRST EDXE ; CAIN B,EDDOT ;IS IT /.? ; JRST EDXD ;SKIP AND (EDXX(CAR A)) PUSH P,A PUSHJ P,EDCAAR PUSHJ P,EDXY EDXG: PUSHJ P,EDXZ ;CONS(EDXX(CAR A))(EDXX(CDR A))) EDXGA: PUSH P,A PUSHJ P,EDXZ POP P,C POP P,B HRLM C,(B) ;RPLACA A (EDXX(CAR A)) HRRM A,(B) EXPOP: EXCH A,B POPJ P, EDXY: CAIE A,EDLP JRST POPJ1 POPJ P, OSUBTTL GENERIC ARITHMETIC PREDICATES PLUSP: JSP F,0P1 MINUSP: JSP F,0P1 0P: JSP F,0P1 CX$ 0P0: %WTA NMV5 ;COMPLEX AND DUPLEX NOT PERMITTED 0P1: JSP T,NMSKIP BG$ JRST 0P2 ;BIGNUM DX$ JRST 0P0 ;DUPLEX CX$ JRST 0P0 ;COMPLEX DB$ JRST 0P2 ;DOUBLE JRST 0P2 ;FLONUM 0P2: XCT 0P9-PLUSP-1(F) ;FIXNUM JRST FALSE 0P9: JUMPG TT,TRUE ;PLUSP JUMPL TT,TRUE ;MINUSP JUMPE TT,TRUE ;0P ZEROP: JSP T,NMSKIP BG$ JRST FALSE ;BIGNUM - NEVER ZERO DX$ JRST ZEROP3 ;DUPLEX CX$ JRST ZEROP2 ;COMPLEX DB$ JRST ZEROP1 ;DOUBLE JRST ZEROP1 ;FLONUM ZEROP1: JUMPN TT,FALSE ;FIXNUM JRST TRUE IFN CXFLAG,[ ZEROP2: SKIPN (A) ;CHECK REAL PART SKIPE 1(A) ;CHECK IMAGINARY PART JRST FALSE JRST TRUE ] ;END OF IFN CXFLAG IFN DXFLAG,[ ZEROP3: SKIPN (A) ;CHECK REAL PART SKIPE 2(A) ;CHECK IMAGINARY PART JRST FALSE JRST TRUE ] ;END OF IFN DXFLAG SUBTTL GENERIC ARITHMETIC ROUTINES OF ONE ARGUMENT DEFINE N1OPCK TAB ;CHECK FOR CORRECT LENGTH OF A ONE-ARG NUM OP TABLE IFN .--NN1OPS, WARN [WRONG LENGTH TABLE] TERMIN MINUS: JSP F,ABS9 CX$ CONJUGATE: JSP F,ABS9 SUB1: JSP F,ABS9 ADD1: JSP F,ABS9 ABS: JSP F,ABS9 ABS9: JSP T,NMSKIP ;LEAVES VALUE IN TT; CLEARS PC FLAGS BG$ JRST ABS9BG-MINUS-1(F) ;BIGNUM DX$ JRST ABS9DX-MINUS-1(F) ;DUPLEX CX$ JRST ABS9CX-MINUS-1(F) ;COMPLEX DB$ JRST ABS9DB-MINUS-1(F) ;DOUBLE JRST ABS9FL-MINUS-1(F) ;FLONUM JRST ABS9FX-MINUS-1(F) ;FIXNUM NN1OPS==:ABS9-MINUS ;NUMBER OF GENERIC NUMERIC OPERATIONS OF ONE ARG ABS9FX: JRST MNSFX ;MINUS CX$ JRST PDLNKJ ;CONJUGATE AOJA TT,ADD1FX ;ADD1 SOJA TT,SUB1FX ;SUB1 MOVMS TT ;ABS N1OPCK ABS9FX JUMPGE TT,FIX1 ABSOV: BG% JRST OVFLER IFN BIGNUM,[ SKIPA TT,R70 ;COME HERE TO CONSTRUCT 400000000000 AS A BIGNUM SUB1V1: MOVEI TT,1 ;COME HERE TO CONSTRUCT 400000000001 AS A BIGNUM PUSH P,B PUSH FXP,T ;? PUSHJ P,CONS1FX MOVEI TT,1 PUSHJ P,CONSFX PUSHJ P,BNCONS POP FXP,T ;? JRST POPBJ ] ;END OF IFN BIGNUM MNSFX: MOVNS TT ADD1FX: JFCL 8,ABSOV JRST FIX1 SUB1FX: BG$ JFCL 8,SUB1V1 BG% JFCL 8,OVFLER JRST FIX1 IFN BIGNUM,[ SUB1OV: PUSHJ P,SUB1OV ;COME HERE TO CONSTRUCT -400000000001 AS A BIGNUM HRROS (A) POPJ P, ] ;END OF IFN BIGNUM ABS9FL: JRST MNSFL ;MINUS CX$ JRST PDLNKJ ;CONJUGATE JRST SUB1FL ;SUB1 JRST ADD1FL ;ADD1 MOVMS TT ;ABS N1OPCK ABS9FL JRST FLOAT1 ADD1FL: FADRI TT,(1.0) JRST FLOAT1 SUB1FL: FSBRI TT,(1.0) JRST FLOAT1 MNSFL: MOVNS TT JRST FLOAT1 IFN DBFLAG,[ ABS9DB: JRST MNSDB ;MINUS CX$ JRST PDLNKJ ;CONJUGATE JRST SUB1DB ;SUB1 JRST ADD1DB ;ADD1 SKIPGE TT ;ABS N1OPCK ABS9DB KA DFN TT,D KIKL DMOVN TT,TT JRST DBL1 ADD1DB: KA MOVE R,D KA FADL TT,[1.0] KA UFA D,R KA FADL TT,R KIKL DFAD TT,D1.0 JRST DBL1 SUB1DB: KA DFN TT,D KA MOVE R,D KA FADL TT,[1.0] KA UFA D,R KA FADL TT,R KA DFN TT,D KIKL DFSB TT,D1.0 JRST DBL1 KIKL D1.0: 1.0 ? 0 MNSDB: KA DFN TT,D KIKL DMOVN TT,TT JRST DBL1 ] ;END OF IFN DBFLAG IFN CXFLAG,[ ABS9CX: JRST MNSCX ;MINUS JRST CNJCX ;CONJUGATE JRST SUB1CX ;SUB1 JRST ADD1CX ;ADD1 KIKL DMOVE TT,(A) ;ABS KA MOVE TT,(A) N1OPCK ABS9CX KA MOVE D,1(A) FMPR TT,TT ;TRY TO DO THE CHEAP, STRAIGHTFORWARD THING FMPR D,D ;REMEMBER, THE DISPATCH RESET THE PC FLAGS FADR TT,D JFCL 8,CABS1 ;JUMP IF WE LOST ON OVERFLOW/UNDERFLOW JRST SQRT.. ;WE WON! TAKE THE SQUARE ROOT CABS1: KIKL DMOVE TT,(A) ;ON FAILURE, WE TRY A MORE HAIRY SCALING TRICK KA MOVE TT,(A) KA MOVE D,1(A) LDB F,[331000,,TT] ;GET 200+ LDB R,[331000,,D] ;GET 200+ CAIL R,(F) JRST CABS2 EXCH D,TT ;THE ONE IN TT/F SHOULD HAVE THE EXCH R,F ; LARGER EXPONENT CBAS2: SUBI R,(F) ;F GETS DIFFERENCE OF EXPONENTS (NON-POSITIVE) CAMG R,[-100] ;IF DIFFERENCE IS AT LEAST 100, THEN RETURN JRST FLOAT1 ; THE BIG COMPONENT (THE OTHER IS NEGLIGIBLE) MOVNI R,-200(F) FSC TT,(R) ;SCALE EXPONENT DOWN TO 0 FSC D,(R) ;SCALE EXPONENT EVEN LOWER (BUT BIGGER THAN -100) FMPR TT,TT FMPR D,D FADR TT,D PUSHJ P,SQRT.. ;SAVES F FSC TT,(F) ;SCALE ANSWER BACK ;??? JRST FLOAT1 ADD1CX: MOVE TT,(A) FADRI TT,(1.0) MOVE D,1(A) JRST CMPL1 SUB1CX: MOVE TT,(A) FSBRI TT,(1.0) MOVE D,1(A) JRST CMPL1 CNJCX: SKIPA TT,(A) MNSCX: MOVN TT,(A) MOVN D,1(A) JRST CMPL1 ] ;END OF IFN CXFLAG IFN DXFLAG,[ ABS9DX: JRST MNSDX ;MINUS JRST CNJDX ;CONJUGATE JRST SUB1DX ;SUB1 JRST ADD1DX ;ADD1 .VALUE .ERR DUPLEX ABSOLUTE VALUE? N1OPCK ABS9DX ADD1DX: KA MOVE R,(A) KA MOVE TT,1(A) KA FADL R,[1.0] KA UFA TT,F KA FADL R,D KA MOVE TT,2(A) KA MOVE D,3(A) KIKL DMOVE R,(A) KIKL DFAD R,D1.0 KIKL DMOVE TT,2(A) JRST DUPL1 SUB1DX: KA MOVE R,(A) KA MOVE TT,1(A) KA DFN R,TT KA FADL R,[1.0] KA UFA TT,F KA FADL R,D KA DFN R,F KA MOVE TT,2(A) KA MOVE D,3(A) KIKL DMOVE R,(A) KIKL DFSB R,D1.0 KIKL DMOVE TT,2(A) JRST DUPL1 CNJDX: KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT(A) KA DFN TT,D KIKL DMOVE R,(A) KIKL DMOVN TT,2(A) JRST DUPL1 MNSDX: KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT(A) KA DFN R,F KA DFN TT,D KIKL DMOVN R,(A) KIKL DMOVN TT,2(A) JRST DUPL1 ] ;END OF IFN DXFLAG IFN BIGNUM,[ ABS9BG: JRST MNSBG ;MINUS CX$ POPJ P, ;CONJUGATE JRST SUB1BG ;SUB1 JRST ADD1BG ;ADD1 JRST ABSBG ;ABS N1OPCK ABS9BG ADD1BG: PUSH P,B PUSH P,CPOPBJ MOVEI B,IN1 JRST .PLUS SUB1BG: PUSH P,B PUSH P,CPOPBJ MOVEI B,IN1 JRST .DIF ] ;END OF IFN BIGNUM SUBTTL GENERIC ARITHMETIC ROUTINES OF N ARGUMENTS DEFINE NMOPCK TAB ;CHECK FOR CORRECT LENGTH OF A NUM OP TABLE IFN .--NNMOPS, WARN [WRONG LENGTH TABLE] TERMIN DEFINE AROPCK TAB ;CHECK FOR CORRECT LENGTH OF AN ARITH OP TABLE IFN .--NAROPS, WARN [WRONG LENGTH TABLE] TERMIN .PLUS: JSP F,.NL0 .DIF: JSP F,.NL0 .TIMES: JSP F,.NL0 .QUO: JSP F,.NL0 NAROPS==:.-.PLUS ;NUMBER OF GENERIC ARITHMETIC OPERATIONS .GREAT: JSP F,.NL0 .LESSP: JSP F,.NL0 .MAX: JSP F,.NL0 .MIN: JSP F,.NL0 NNMOPS==:.-.PLUS ;NUMBER OF GENERIC NUMBER OPERATIONS .NL0: PUSH P,A PUSH P,B MOVNI T,2 JRST PLUS-.PLUS-1(F) PLUS: JSP F,NL0 DIFFERENCE: JSP F,NL0 TIMES: JSP F,NL0 QUOTIENT: JSP F,NL0 AROPCK PLUS GREATERP: JSP F,NL0 LESSP: JSP F,NL0 MAXIMUM: JSP F,NL0 MINIMUM: JSP F,NL0 NMOPCK PLUS NL0: SETZM REMFL ;FOR QUOTIENT ;??? SHOULD SETZM ONLY FOR BIGNUM CASE AOJL T,NL1 JUMPE T,@NL0A-PLUS-1(F) XCT NL0B-PLUS-1 POPJ P, NL0C: 2DIF [MOVEI D,(F)]QPLUS,PLUS+1 SOJA T,WNALOSE ;WHERE TO GO FOR ONLY ONE ARGUMENT (SETZ => IS A PREDICATE, NOT NUMERIC-VALUED) NL0A: NMCK0 ;PLUS NMCK0 ;DIFFERENCE NMCK0 ;TIMES NMCK0 ;QUOTIENT AROPCK NL0A SETZ NL0C ;GREATERP SETZ NL0C ;LESSP NMCK0 ;MAXIMUM NMCK0 ;MINIMUM NMOPCK NL0A ;WHAT TO DO FOR 0 ARGUMENTS (ALSO, HRRZI IS NEGATIVE AND JRST POSITIVE, ; SO SIGN BIT ENCODES WHETHER COMPLEX NUMBERS ARE ACCEPTABLE) NL0B: HRRZI A,IN0 ;PLUS RETURN 0 HRRZI A,IN0 ;DIFFERENCE RETURN 0 HRRZI A,IN1 ;TIMES RETURN 1 HRRZI A,IN1 ;QUOTIENT RETURN 1 AROPCK NL0B JRST NL0C ;GREATERP ERROR JRST NL0C ;LESSP ERROR JRST NL0C ;MAXIMUM ERROR JRST NL0C ;MINIMUM ERROR NMOPCK NL0B SUBTTL FIXNUM GENERIC ARITHMETIC LOOP, AND INITIAL DISPATCH ;;; HERE WE PICK UP THE FIRST ARGUMENT AND DISPATCH TO ONE ;;; OF SEVERAL ARITHMETIC LOOPS. THE TYPE OF THE ACCUMULATION ;;; IS "ENCODED IN THE PC", AND IS DETERMINED BY THE LOOP ;;; WE ARE IN. THE GENERAL USAGE OF ACCUMULATORS IS: ;;; TT NEXT VALUE TO OPERATE ON ;;; D (AND PERHAPS R) ACCUMULATED VALUE ;;; F OPERATION INDEX ;;; A, B, AND T MAY ALSO BE USED. IF THE ACCUMULATION ;;; WILL NOT FIT INTO TWO ACCUMULATORS, OR IT IS NOT ;;; CONVENIENT, THEN IT IS KEPT ON FXP. NL1: MOVNI TT,-1(T) HRLI TT,(TT) PUSH FXP,TT ;SUBTRACTING THIS FROM P WILL POP ALL ARGUMENTS ADDI T,1(P) TLZ T,-1 ;MAKE UP ARGUMENT POINTER PUSH FXP,T MOVE A,-1(T) ;GET FIRST ARGUMENT NL2: JSP T,NMSKIP ;AND WE'RE OFF! BG$ JRST NLBG1 ;BIGNUM DX$ JRST NLDX1 ;DUPLEX CX$ JRST NLCX1 ;COMPLEX DB$ JRST NLDB1 ;DOUBLE JRST NLFL1 ;FLONUM NLFX1: MOVE D,TT ;FIXNUM NLFX2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ ... ;BIGNUM DX$ ... ;DUPLEX CX$ ... ;COMPLEX DB$ ... ;DOUBLE JRST ;FLONUM BG$ MOVE T,D ;SAVE ACCUMULATION IN CASE OF OVERFLOW XCT NLFX7-PLUS-1(F) ;PERFORM OPERATION JFCL 8,NLFX8-PLUS-1(F) NLFX4: AOS T,(FXP) CAIG T,(P) JRST NLFX2 MOVE TT,D SUB P,-1(FXP) POPI FXP,2 SKIPL NL0A-PLUS-1(F) JRST FIX1 JRST TRUE NLFALSE: SUB P,-1(FXP) POPI FXP,2 JRST FALSE ;OPERATION FOR FIXED MEETS FIXED NLFX7: ADD D,TT ;PLUS SUB D,TT ;DIFFERENCE IMUL D,TT ;TIMES IDIV D,TT ;QUOTIENT AROPCK NLFX7 JSP A,NLFXGR ;GREATERP JSP A,NLFXLS ;LESSP JSP A,NLFXMX ;MAXIMUM JSP A,NLFXMN ;MINIMUM NMOPCK NLFX7 NLFXGR: CAMG D,TT ;GREATERP, FIXNUM MEETS FIXNUM (OR FLONUM MEETS FLONUM) JRST NLFALSE MOVE D,TT JRST 1(A) NLFXLS: CAML D,TT ;LESSP, FIXNUM MEETS FIXNUM (OR FLONUM MEETS FLONUM) JRST NLFALSE MOVE D,TT JRST 1(A) NLFXMX: CAMGE D,TT ;MAXIMUM, FIXNUM MEETS FIXNUM (OR FLONUM MEETS FLONUM) MOVE D,TT JRST 1(A) NLFXMN: CAMLE D,TT ;MINIMUM, FIXNUM MEETS FIXNUM (OR FLONUM MEETS FLONUM) MOVE D,TT JRST 1(A) ;WHAT TO DO ON OVERFLOW FROM FIXED MEETS FIXED NLFX8: BG% JRST OVFLER ;PLUS BG$ ... BG% JRST OVFLER ;DIFFERENCE BG$ ... BG% JRST OVFLER ;TIMES BG$ ... JRST QUOFXO ;QUOTIENT AROPCK NLFX8 QUOFXO: CAMN D,[400000,,0] JRST QUOFX2 QUOFX1: SKIPN RWG JRST OVFLER SKIPGE T SOSA D,T AOS D,T BG% JFCL 8,OVFLER BG$ JFCL 8,PLOV JRST NLFX4 QUOFX2: BG$ CAMN TT,XC-1 ;SETZ/1 => POSITIVE SETZ BG$ JRST DIVSEZ CAIE TT,1 ;SETZ/(-1) => SETZ (BUT CRETINOUS HARDWARE OVERFLOWS ANYWAY) JRST QUOFX1 MOVE D,T ;FOR THE SAKE OF MIT-AI, WHOSE MACHINE DOESN'T WORK RIGHT, JRST NLFX4 ; WE MUST EXPLICITLY MOVE THE SETZ BACK TO D SUBTTL FLONUM GENERIC ARITHMETIC LOOP ;;; ZFUZZ CHECK ;;; CALL WITH JSP A,ZFZCHK TO PRESERVE PC FLAGS IN A. ZFZCHK: PUSH FXP,T MOVE T,D JRST 2,@[.+1] ;CLEAR PC FLAGS FDVR T,TT ;DIVIDE SUM (DIFFERENCE) BY ONE ARGUMENT JFCL 8,ZFZCH7 ;OVERFLOW OR UNDERFLOW MOVM T,T CAMGE T,@VZFUZZ ;COMPARE ABSOLUTE VALUE WITH VALUE OF ZFUZZ SETZ D, ;ZERO RESULT IF LESS THAN FUZZ ZFZCH9: POP FXP,T JRST 2,(A) ;RETURN, RESTORING PC FLAGS ZFZCH7: JSP T,.+1 ;GET PC FLAGS IN T TLNE T,%PCFXU SETZ D, ;FOR UNDERFLOW, MAKE RESULT 0 JRST ZFZCH9 ;FOR OVERFLOW, DON'T RESET RESULT ;;; FLOATING OVERFLOW HACK ;;; CALL WITH JSP A,FLOVHK TO LEAVE PC FLAGS IN A. ;;; SIGNALS ERROR UNLESS IT WAS AN UNDERFLOW WITH ZUNDERFLOW NON-NIL. FLOVHK: SKIPE VZUNDERFLOW TLNN A,%PCFXU JRST UNOVER SETZ D, ;FOR UNDERFLOW WITH ZUNDERFLOW NON-NIL, USE ZERO TLZ A,-1 JRST 2,(A) ;RESET PC FLAGS ON RETURN DEFINE FLOVCK M ;FLOATING OVERFLOW CHECK IFSE [M], WARN [MISSING ARGUMENT TO FLOVCK] JFCL 8,[ IFN <,,M>-D, EXCH D,M ;M MAY HAVE AN INDEX FIELD JSP A,FLOVHK IFN <,,M>-D, EXCH D,M JRST .+1 ] TERMIN DEFINE FLFZCK TEST=[SKIPE VZFUZZ] ;FLOATING OVERFLOW CHECK PLUS FUZZ CHECK JFCL 8,[ JSP A,FLOVHK ? JRST .+3 ] TEST JSP A,ZFZCHK TERMIN NLFL1: MOVE D,TT NLFL2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ ... ;BIGNUM DX$ JRST NLFLDX ;DUPLEX CX$ JRST NLFLCX ;COMPLEX DB$ JRST NLFLDB ;DOUBLE JRST NLFLFL ;FLONUM JSP T,IFLOAT ;FIXNUM (CONVERT TO FLOATING) NLFLFL: XCT NLFL7-PLUS-1(F) ;PERFORM OPERATION (MAY SKIP OVER JFCL 8, IN FLFZCK!) FLFZCK [XCT NLFL8-PLUS-1(F)] NLFL4: AOS T,(FXP) CAIG T,(P) ;SKIP IF ALL ARGUMENTS PROCESSED JRST NLFL2 MOVE TT,D SUB P,-1(FXP) POPI FXP,2 SKIPL NL0A-PLUS-1(F) JRST FLOAT1 JRST TRUE IFN DBFLAG,[ ;FLONUM MEETS DOUBLE NLFLDB: SETZ R, ;CONVERT FLONUM TO DOUBLE JRST NLDBDB ;ENTER DOUBLE ARITHMETIC LOOP ] ;END OF IFN DBFLAG IFN CXFLAG,[ ;FLONUM MEETS COMPLEX NLFLCX: SETZ R, ;CONVERT FLONUM TO COMPLEX JRST NLCXCX ;ENTER COMPLEX ARITHMETIC LOOP ] ;END OF IFN CXFLAG IFN DXFLAG,[ ;FLONUM MEETS DUPLEX NLFLDX: SETZ R, ;CONVERT FLONUM TO DOUBLE JRST NLDBDX ;NOW DO DOUBLE MEETS DUPLEX BIT ] ;END OF IFN DXFLAG ;OPERATION FOR FLOATING MEETS FLOATING NLFL7: FADR D,TT ;PLUS FSBR D,TT ;DIFFERENCE FMPR D,TT ;TIMES FDVR D,TT ;QUOTIENT AROPCK NLFL7 JSP A,NLFXGR ;GREATERP JSP A,NLFXLS ;LESSP JSP A,NLFXMX ;MAXIMUM JSP A,NLFXMN ;MINIMUM NMOPCK NLFL7 ;SKIP UNLESS ZFUZZ HACK DESIRED ; (ALSO, TRNA IS NEGATIVE AND SKIPE POSITIVE, SO SIGN BIT ENCODES PLUS/DIFFERENCE ; FOR THE FIRST FOUR OPERATIONS) NLFL8: SKIPE VZFUZZ ;PLUS SKIPE VZFUZZ ;DIFFERENCE TRNA ;TIMES TRNA ;QUOTIENT AROPCK NLFL8 CAIA ;GREATERP CAIA ;LESSP CAIA ;MAXIMUM CAIA ;MINIMUM NMOPCK NLFL8 SUBTTL DOUBLE GENERIC ARITHMETIC LOOP IFN DBFLAG,[ DEFINE DBOVCK M ;FLOATING OVERFLOW CHECK IFSE [M], WARN [MISSING ARGUMENT TO DBOVCK] JFCL 8,[ IFN <,,M>-D, EXCH D,M ;M MAY BE INDEXED JSP A,FLOVHK IFN <,,M>-D, EXCH D,M SKIPN M ;IF FLOVCK ZEROED D, MUST ZERO SECOND WORD SETZM+<<,,M>_-22,,<,,M>+1> ;CAREFUL! JRST .+1 ] TERMIN DEFINE DBFZCK TEST=[SKIPE VDFUZZ] ;DOUBLE OVERFLOW CHECK PLUS FUZZ CHECK JFCL 8,[ JSP A,FLOVHK ? SKIPN D ? SETZ R, ? JRST .+3 ] TEST JSP A,DFZCHK TERMIN NLDB1: KA MOVE D,TT KA MOVE R,1(A) KIKL DMOVE D,(A) NLDB2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ ... ;BIGNUM DX$ JRST NLDBDX ;DUPLEX CX$ JRST NLDBCX ;COMPLEX JRST NLDBDB ;DOUBLE JRST NLDBFL ;FLONUM PUSH FXP,D ;FIXNUM (CONVERT TO DOUBLE) JSP T,IDFLOAT KA MOVE T,TT KA MOVE TT,D KIKL DMOVE T,TT POP FXP,D JRST NLDB3 NLDBFL: KIKL MOVE T,TT TDZA TT,TT ;EXTEND FLONUM TO BE A DOUBLE NLDBDB: KA MOVE TT,1(A) KA MOVE T,(A) KIKL DMOVE T,(A) NLDB3: XCT NLDB7-PLUS-1(F) ;PERFORM OPERATION DBFZCK NLDB4: AOS T,(FXP) CAIG T,(P) ;SKIP IF ALL ARGUMENTS PROCESSED JRST NLDB2 KA MOVE TT,D KA MOVE D,R KIKL DMOVE TT,D SUB P,-1(FXP) POPI FXP,2 SKIPL NL0A-PLUS-1(F) JRST DBL1 JRST TRUE IFN CXFLAG,[ ;DOUBLE MEETS COMPLEX NLDBCX: REPEAT 2, PUSH FXP,R70 ;CONVERT DOUBLE TO DUPLEX JRST NLDXCX ;NOW DO DUPLEX MEETS COMPLEX THING ] ;END OF IFN CXFLAG IFN DXFLAG,[ ;DOUBLE MEETS DUPLEX NLDBDX: REPEAT 2, PUSH FXP,R70 ;CONVERT DOUBLE TO DUPLEX JRST NLDXDX ;NOW ENTER DUPLEX ARITHMETIC LOOP ] ;END OF IFN DXFLAG ;;; DFUZZ CHECK ;;; CALL WITH JSP A,DFZCHK TO PRESERVE PC FLAGS IN A. ;;; THE VALUE OF DFUZZ SHOULD BE IN B. (B MAY BE CLOBBERED.) DFZCHK: PUSH FXP,D PUSH FXP,R JRST 2,@[.+1] ;CLEAR PC FLAGS KA PUSHJ P,KADFDV KIKL DFDV D,T JFCL 8,ZFZCH7 SKIPGE D KA DFN D,R KIKL DMOVN D,D CAMGE D,(B) JRST DFZCH5 CAMG D,(B) CAML R,1(B) JRST DFZCH9 DFZCH5: SETZM -1(FXP) SETZM (FXP) DFZCH9: POP FXP,R POP FXP,D JRST 2,(A) ;RETURN, RESTORING PC FLAGS DFZCH7: JSP B,.+1 ;GET PC FLAGS IN B TLNE B,%PCFXU JRST DFZCH5 ;UNDERFLOW => RESET RESULT TO ZERO JRST DFZCH9 ;OVERFLOW => DON'T RESET RESULT ;OPERATION FOR DOUBLE MEETS DOUBLE NLDB7: IFN KA10,[ PUSHJ P,KADFAD ;PLUS PUSHJ P,KADFSB ;DIFFERENCE PUSHJ P,KADFMP ;TIMES PUSHJ P,KADFDV ;QUOTIENT ] ;END OF IFN KA10 IFN KI10+KL10,[ DFAD D,T ;PLUS DFSB D,T ;DIFFERENCE DFMP D,T ;TIMES DFDV D,T ;QUOTIENT ] ;END OF IFN KI10+KL10 AROPCK NLDB7 JRST NLDBGR ;GREATERP JRST NLDBLS ;LESSP JRST NLDBMX ;MAXIMUM JRST NLDBMN ;MINIMUM NMOPCK NLDB7 ;SKIP UNLESS DFUZZ HACK DESIRED NLDB8: SKIPE B,VDFUZZ ;PLUS SKIPE B,VDFUZZ ;DIFFERENCE CAIA ;TIMES CAIA ;QUOTIENT AROPCK NLDB8 IFN KA10,[ ;;; KA10 DOUBLE-PRECISION ARITHMETIC ROUTINES ;;; (D,R) OP (T,TT) => (D,R) AND SAVES ALL OTHER ACS. ;;; SEE DEC PDP-10 SYSTEM REFERENCE HANDBOOK. KADFSB: DFN T,TT ;TO SUBTRACT, NEGATE SECOND ARG KADFAD: PUSH FXP,F ;ADDITION UFA R,TT ;SUM OF LOW PARTS TO F FADL D,T ;SUM OF HIGH PARTS TO (D,R) UFA R,F ;ADD LOW PART OF HIGH SUM INTO F FADL D,F ;ADD LOW SUM TO HIGH SUM POP FXP,F POPJ P, KADFAZ: PUSHJ P,KSDFAD ;ADDITION WITH OVERFLOW AND FUZZ CHECK DBFXCK POPJ P, KADFSZ: PUSHJ P,KSDFSB ;SUBTRACTION WITH OVERFLOW AND FUZZ CHECK DBFXCK POPJ P, KADFMP: PUSH FXP,F ;MULTIPLICATION MOVE F,D FMPR F,TT ;ONE CROSS PRODUCT IN F FMPR R,T ;OTHER CROSS PRODUCT IN R UFA R,F ;ADD R INTO F FMPL D,T ;HIGH LONG PRODUCT TO (D,R) UFA R,F ;ADD LOW PART INTO CROSS SUM FADL D,F ;ADD LOW PART TO HIGH PART POP FXP,F POPJ P, KADFDV: PUSH FXP,F ;DIVISION FDVL D,T ;GET HIGH PART OF QUOTIENT MOVN F,D ;GET NEGATIVE OF QUOTIENT FMPR F,TT ; AND MULTIPLY BY LOW PART OF DIVISOR UFA R,F ;ADD IN REMAINDER, RESULT IN F FDVR F,T ;DIVIDE BY HIGH PART OF DIVISOR FADL D,F ;ADD INTO ORIGINAL QUOTIENT POP FXP,F POPJ P, KADFMO: PUSHJ P,KADFMP ;MULTIPLICATION WITH OVERFLOW CHECK DBOVCK D POPJ P, KADFDO: PUSHJ P,KADFDV ;DIVISION WITH OVERFLOW CHECK DBOVCK D POPJ P, ] ;END OF IFN KA10 NLDBGR: CAMLE D,TT ;GREATERP, DOUBLE MEETS DOUBLE JRST NLDBG1 CAML D,TT CAMG R,1(A) JRST NLFALSE NLDBG1: MOVE D,TT JRST NLDB4 NLDBLS: CAMGE D,TT ;LESSP, DOUBLE MEETS DOUBLE JRST NLDBL1 CAMG D,TT CAML R,1(A) JRST NLFALSE NLDBL1: MOVE D,TT JRST NLDB4 NLDBMX: CAMGE D,TT ;MAXIMUM, DOUBLE MEETS DOUBLE JRST NLDBX1 CAMG D,TT CAML R,1(A) JRST NLDB4 NLDBX1: KA MOVE D,TT KA MOVE R,1(A) KIKL DMOVE D,(A) JRST NLDB4 NLDBMN: CAMLE D,TT ;MINIMUM, DOUBLE MEETS DOUBLE JRST NLDBN1 CAML D,TT CAMG R,1(A) JRST NLDB4 NLDBN1: KA MOVE D,TT KA MOVE R,1(A) KIKL DMOVE D,(A) JRST NLDB4 ] ;END OF IFN DBFLAG SUBTTL COMPLEX GENERIC ARITHMETIC LOOP IFN CXFLAG,[ NLCX1: SKIPL NL0B-PLUS-1(F) ;SKIP IFF COMPLEX NUMBERS OKAY FOR THIS OPERATION JRST NLCXLZ NLCX1A: KA MOVE D,(A) KA MOVE R,1(A) KIKL DMOVE D,(A) NLCX2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ ... ;BIGNUM DX$ JRST NLCXDX ;DUPLEX JRST NLCXCX ;COMPLEX DB$ JRST NLCXDB ;DOUBLE JRST NLCXFL ;FLONUM JSP T,IFLOAT ;FIXNUM (CONVERT TO FLONUM, THEN DROP IN) NLCXFL: XCT NLFL7-PLUS-1(F) ;PERFORM OPERATION FOR FLONUM MEETS FLONUM FLOVCK D SKIPGE NLFL8-PLUS-1(F) ;SKIP FOR PLUS/DIFFERENCE JRST NLCXF2 XCT NLFL8-PLUS-1(F) ;SKIP UNLESS ZFUZZ HACK DESIRED JSP A,ZFZCHK JRST NLCX4 NLCXF2: EXCH D,R ;MULTIPLY/DIVIDE IMAGINARY PART XCT NLFL7-PLUS-1(F) FLOVCK D EXCH D,R JRST NLCX4 NLCXCX: KA MOVE T,(A) KA MOVE TT,1(A) KIKL DMOVE T,(A) NLCX3: XCT NLCX7-PLUS-1(F) ;PERFORM OPERATION NLCX4: AOS T,(FXP) CAIG T,(P) ;SKIP IF ALL ARGUMENTS PROCESSED JRST NLCX2 KA MOVE TT,D KA MOVE D,R KIKL DMOVE TT,D SUB P,-1(FXP) POPI FXP,2 JRST CMPL1 ;OPERATION CAN'T BE GREATERP OR LESSP IFN DBFLAG,[ ;COMPLEX MEETS DOUBLE NLCXDB: PUSH FXP,R ;CONVERT COMPLEX TO DUPLEX PUSH FXP,R70 SETZ R, JRST NLDXDB ;NOW DO DUPLEX MEETS DOUBLE THING ] ;END OF IFN DBFLAG IFN DXFLAG,[ ;COMPLEX MEETS DUPLEX NLCXDX: PUSH FXP,R ;CONVERT COMPLEX TO DUPLEX PUSH FXP,R70 SETZ R, JRST NLDXDX ;ENTER DUPLEX ARITHMETIC LOOP ] ;END OF IFN DXFLAG ;OPERATION FOR COMPLEX MEETS COMPLEX NLCX7: PUSHJ P,NLCXAD ;PLUS PUSHJ P,NLCXSB ;DIFFERENCE PUSHJ P,NLCXMP ;TIMES PUSHJ P,NLCXDV ;QUOTIENT AROPCK NLCX7 NLCXSB: MOVN T,T ;CHEAPY WAY TO SUBTRACT MOVN TT,TT NLCXAD: FADR D,T ;ADD REAL PARTS FLOVCK D SKIPE VZFUZZ JRST NLCXA7 NLCXA1: EXCH D,R FADR D,TT ;ADD IMAGINARY PARTS FLFZCK EXCH D,R POPJ P, NLCXA7: PUSH FXP,TT MOVE TT,T JSP A,ZFZCHK POP FXP,TT JRST NLCXA1 ;COMPLEX MULTIPLICATION, DONE THE STRAIGHTFORWARD (?) WAY NLCXMP: PUSH FXP,D FMPR D,TT ;PRODUCT BC FLOVCK D FMPR TT,R ;PRODUCT BD FLOVCK TT FMPR R,T ;PRODUCT AD FLOVCK R EXCH D,(FXP) FMPR D,T ;PRODUCT AC FLOVCK D FSBR D,TT ;AC-BD FLFZCK EXCH D,R POP FXP,TT FADR D,TT ;AD+BC FLFZCK EXCH D,R POPJ P, ;COMPLEX DIVISION, DONE STRAIGHTFORWARDLY NLCXDV: PUSH FXP,R PUSH FXP,D FMPR D,D FMPR R,R FADR D,R JFCL 8,OVFLER ;THERE IS NO HOPE IF C^2+D^2 TOO LARGE OR SMALL EXCH D,(FXP) MOVN R,-1(FXP) FMPR R,T ;PRODUCT -AD FLOVCK R FMPR T,D ;PRODUCT AC FLOVCK T FMPR D,TT ;PRODUCT BC FLOVCK D FMPRM TT,-1(FXP) ;PRODUCT BD FLOVCK -1(FXP) MOVE TT,R PUSH FXP,T FADR D,TT ;BC-AD FLFZCK FDVR D,-1(FXP) ;(BC-AD)/(C^2+D^2) FLOVCK D MOVE R,D MOVE D,(FXP) MOVE TT,-2(FXP) FADR D,TT ;AC+BD FLFZCK FDVR D,-1(FXP) ;(AC+BD)/(C^2+D^2) FLOVCK D POPI FXP,3 POPJ P, NLCXLZ: %WTA NMV5 ;UNACCEPTABLE NUMERIC VALUE JRST NL2 ] ;END OF IFN CXFLAG SUBTTL DUPLEX GENERIC ARITHMETIC LOOP IFN DXFLAG,[ ;;; WE ORDINARILY KEEP THE REAL PART IN (D,R) ;;; AND THE IMAGINARY PART IN (-1(FXP),(FXP)). ;;; AFTER FETCHING THE NEXT ARG, WE HAVE: ;;; (D,R) REAL PART OF ACCUMULATION ;;; (-3(FXP),-2(FXP)) IMAGINARY PART OF ACCUMULATION ;;; (T,TT) REAL PART OF NEXT ARGUMENT ;;; (-1(FXP),(FXP)) IMAGINARY PART OF NEXT ARGUMENT NLDX1: SKIPL NL0B-PLUS-1(F) ;SKIP IFF DUPLEX NUMBERS OKAY FOR THIS OPERATION JRST NLCXLZ NLDX1A: KA MOVE D,(A) KA MOVE R,1(A) KIKL DMOVE D,(A) PUSH FXP,2(A) PUSH FXP,3(A) NLDX2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ ... ;BIGNUM JRST NLDXDX ;DUPLEX JRST NLDXCX ;COMPLEX JRST NLDXDB ;DOUBLE JRST NLDXFL ;FLONUM JSP T,IFLOAT ;FIXNUM (CONVERT TO FLONUM, THEN DROP IN) NLDXFL: MOVE T,TT ;CONVERT FLONUM TO A DOUBLE SETZ TT, NLDXDB: XCT NLDB7-PLUS-1(F) ;PERFORM OPERATION FOR DOUBLE MEETS DOUBLE DBOVCK D SKIPGE NLFL8-PLUS-1(F) ;SKIP FOR PLUS/DIFFERENCE JRST NLDXF2 XCT NLDB8-PLUS-1(F) ;SKIP UNLESS DFUZZ HACK DESIRED JSP A,DFZCHK JRST NLDX4 NLDXF2: EXCH D,-1(FXP) ;MULTIPLY/DIVIDE IMAGINARY PART EXCH R,(FXP) XCT NLDB7-PLUS-1(F) ;USE OPERATION FOR DOUBLE MEETS DOUBLE DBOVCK D EXCH D,-1(FXP) EXCH R,(FXP) JRST NLDX4 NLDXCX: PUSH FXP,1(A) ;DUPLEX MEETS COMPLEX PUSH FXP,R70 ;CONVERT THE COMPLEX TO A DUPLEX MOVE T,(A) SETZ TT, NLDXDX: KA MOVE TT,1(A) KA MOVE T,(A) KIKL DMOVE T,(A) NLDX3: XCT NLDX7-PLUS-1(F) ;PERFORM OPERATION (POPS TWO ARG WORDS FROM FXP) NLDX4: AOS T,(FXP) CAIG T,(P) ;SKIP IF ALL ARGUMENTS PROCESSED JRST NLDX2 KA MOVE F,R KA MOVE R,D KIKL DMOVE R,D KA MOVE TT,-1(FXP) KA MOVE D,(FXP) KIKL DMOVE TT,-1(FXP) SUB P,-1(FXP) POPI FXP,4 JRST DUPL1 ;OPERATION CAN'T BE GREATERP OR LESSP ;OPERATION FOR DUPLEX MEETS DUPLEX NLDX7: PUSHJ P,NLDXAD ;PLUS PUSHJ P,NLDXSB ;DIFFERENCE PUSHJ P,NLDXMP ;TIMES PUSHJ P,NLDXDV ;QUOTIENT AROPCK NLDX7 NLDXSB: REPEAT 2,[ KA DFN T,TT ;CHEAPY WAY TO SUBTRACT KIKL DMOVN T,T EXCH T,-1(FXP) EXCH TT,(FXP) ] ;END OF REPEAT 2 NLDXAD: KA PUSHJ P,KADFAZ ;ADD REAL PARTS KIKL DFAD D,T KIKL DBFZCK EXCH D,-3(FXP) EXCH R,-2(FXP) POP FXP,TT POP FXP,T KA PUSHJ P,KADFAZ ;ADD IMAGINARY PARTS KIKL DFAD D,T KIKL DBFZCK EXCH D,-1(FXP) EXCH R,(FXP) POPJ P, ;DUPLEX MULTIPLY, DONE THE STRAIGHTFORWARD (?) WAY NLDXMP: IFN KI10+KL10,[ PUSH FXP,D PUSH FXP,R DFMP D,-3(FXP) ;PRODUCT AD DBOVCK D EXCH D,-3(FXP) EXCH R,-2(FXP) DFMP D,-5(FXP) ;PRODUCT BD DBOVCK D EXCH D,-5(FXP) EXCH R,-4(FXP) DFMP D,T ;PRODUCT BC DBOVCK D DFMP T,-1(FXP) ;PRODUCT AC DBOVCK T EXCH T,-3(FXP) EXCH TT,-2(FXP) DFAD D,T ;BC+AD DBFZCK DMOVE T,-5(FXP) DMOVEM D,-5(FXP) DMOVE D,-3(FXP) DFSB D,T ;AC-BD DBFZCK POPI FXP,4 POPJ P, ] ;END OF IFN KI10+KL10 IFN KA10,[ PUSH FXP,D PUSH FXP,R PUSHJ P,KADFMO ;PRODUCT AC PUSH FXP,D PUSH FXP,R MOVE D,-7(FXP) MOVE R,-6(FXP) PUSHJ P,KADFMO ;PRODUCT BC EXCH D,-7(FXP) EXCH R,-6(FXP) MOVE T,-5(FXP) MOVE TT,-4(FXP) PUSHJ P,KADFMO ;PRODUCT BD EXCH D,-3(FXP) EXCH R,-2(FXP) PUSHJ P,KADFMO ;PRODUCT AD MOVE T,-7(FXP) MOVE TT,-6(FXP) PUSHJ P,KADFAZ ;AD+BC MOVEM D,-7(FXP) MOVEM R,-6(FXP) MOVE D,-1(FXP) MOVE R,(FXP) MOVE T,-3(FXP) MOVE TT,-2(FXP) PUSHJ P,KADFSZ ;AC-BD POPI FXP,6 POPJ P, ] ;END OF IFN KA10 ;DUPLEX DIVISION, DONE STRAIGHTFORWARDLY ;;; NOT FINISHED - THIS IS REALLY SINGLE PRECISION CODE! NLDXDV: PUSH FXP,R PUSH FXP,D FMPR D,D FMPR R,R FADR D,R JFCL 8,OVFLER ;THERE IS NO HOPE IF C^2+D^2 TOO LARGE OR SMALL EXCH D,(FXP) MOVN R,-1(FXP) FMPR R,T ;PRODUCT -AD DBOVCK R FMPR T,D ;PRODUCT AC DBOVCK T FMPR D,TT ;PRODUCT BC DBOVCK D FMPRM TT,-1(FXP) ;PRODUCT BD DBOVCK -1(FXP) MOVE TT,R PUSH FXP,T FADR D,TT ;BC-AD DBFZCK FDVR D,-1(FXP) ;(BC-AD)/(C^2+D^2) DBOVCK D MOVE R,D MOVE D,(FXP) MOVE TT,-2(FXP) FADR D,TT ;AC+BD DBFZCK FDVR D,-1(FXP) ;(AC+BD)/(C^2+D^2) DBOVCK D POPI FXP,3 POPJ P, ] ;END OF IFN DXFLAG SUBTTL BIGNUM GENERIC ARITHMETIC LOOP ;;; IN THIS LOOP WE TYPICALLY KEEP THE "BIGNUM HEADERS" ;;; IN TT AND D. WE NEEDN'T FEAR THE GARBAGE COLLECTOR ;;; SINCE THE ARGUMENTS ARE ON THE REGPDL. THE BIGNUM ;;; ARITHMETIC ROUTINES MAY USE A AND B TO KEEP COPIES ;;; OF TT AND D TO PROTECT INTERMEDIATE RESULTS FROM GC. NLBG1: MOVE D,TT NLBG2: MOVE A,@(FXP) JSP T,NMSKIP ;GET NEXT ARGUMENT BG$ JRST NLBGBG ;BIGNUM DX$ JRST NLBGDX ;DUPLEX CX$ JRST NLBGCX ;COMPLEX DB$ JRST NLBGDB ;DOUBLE JRST NLBGFL ;FLONUM XCT NLBG6-PLUS-1(F) ;FIXNUM ;OPERATIONS FOR BIGNUM MEETS FIXNUM NLBG6: JRST NLADBX ;PLUS JRST NLSBBX ;DIFFERENCE JRST NLMPBX ;TIMES JRST NLDVBX ;QUOTIENT AROPCK NLBG6 JRST NLGRBX ;GREATERP JRST NLLSBX ;LESSP JRST NLMXBX ;MAXIMUM JRST NLMNBX ;MINIMUM NMOPCK NLBG6 ###### XCT NLBG7-PLUS-1(F) ;PERFORM OPERATION JFCL 8,NLBG8-PLUS-1(F) NLBG4: AOS T,(FXP) CAIG T,(P) JRST NLBG2 MOVE TT,D SUB P,-1(FXP) POPI FXP,2 SKIPL NL0A-PLUS-1(F) JRST FIX1 JRST TRUE  $ ;;; ************************************************************** TITLE ***** MACLISP ****** NEWIO DISPLAY SLAVE PACKAGE ************* ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** .FASL IF1, .INSRT SYS:.FASL DEFS .MLLIT==1 TMPC==0 ;TEMP CHANNEL VERPRT SLAVE ;;; IMPURE AREA! BEWARE! SIXOPD: 0 SIXPG: 0 DEFINE FOODEF NAM,PT DEFINE NAM @ TERMIN TERMIN ZZ==100 .XCREF ZZ FOOTBL: IRP A,,[DENABL,DFUNCTION,ERRLOC,ASTATE,ARYNUM,XARG,YARG,PENPOS,DBRITE DSCALE,WRDCNT,MORFLG,DBUFFER] FOODEF A,\.-FOOTBL ZZ ZZ==ZZ+1 TERMIN ;ARGUMENT CELLS LFOOTBL==.-FOOTBL BFLNTH==1777-ZZ ZZ==1 .XCREF ZZ IRP FOO,,[CREATE,DISADD,DISSUB,DFLUSH,DDISALINE,DCLEAR,DMOVE,DGET,DSEND BLINK,UNBLINK,DCHANGE,DTEXT,DCOPY,WHERE,DPOINT,DNOOP,SHOWPEN,HIDEPEN LINK,UNLINK,MOTION,DLISTINF,DLIST,DSET,DFRAME] FOO==ZZ ZZ=ZZ+1 .XCREF ZZ TERMIN DEFINE DISON .SPECIAL ^F TERMIN DEFINE DISPON .SPECIAL ^N TERMIN DEFINE DISFIL .SPECIAL THE-DISPLAY-SLAVE-DIS-DEVICE-FILE TERMIN DEFINE SIXFIL .SPECIAL THE-DISPLAY-SLAVE-PDP-6-FILE TERMIN DEFINE SIXCHN .SPECIAL THE-DISPLAY-SLAVE-PDP-6-CHANNEL TERMIN .SXEVAL (SETQ ^F NIL ^N NIL THE-DISPLAY-SLAVE-DIS-DEVICE-FILE NIL THE-DISPLAY-SLAVE-PDP-6-FILE NIL THE-DISPLAY-SLAVE-PDP-6-CHANNEL NIL) .ENTRY DISPLAY SUBR 0003 ;SUBR 2 DISPLAY: MOVEI R,DISADD ;FOR BACKTRACEING PURPOSES, THIS IS HERE JRST DISP1 .ENTRY THE-DISPLAY-SLAVE-^Y-INTERRUPT SUBR 0003 ;SUBR 2 CN.Y: PUSHJ P,CLZDIS SKIPE DISON SKIPN SIXOPD POPJ P, SETZM DENABL SETZM DISON PUSHJ P,DISLEEP JRST YF.MES POPJ P, .ENTRY THE-DISPLAY-SLAVE-^N-INTERRUPT SUBR 0003 ;SUBR 2 CN.N: SKIPN DISFIL POPJ P, SKIPE DISON SKIPN SIXOPD JRST CN.N1 SETZM DENABL PUSHJ P,DISLEEP JRST DERR0(A) CN.N1: SETZM DISON PUSH P,[CN.N2] PUSH P,[.SX ((DIS)) ] PUSH P,[.SX (OUT SINGLE ASCII) ] MOVNI T,2 JCALL 16,.FUNCTION OPEN CN.N2: MOVEM A,DISFIL HRRZ B,.SPECIAL OUTFILES CALL 2,.FUNCTION CONS MOVEM B,.SPECIAL OUTFILES MOVEI A,.ATOM T MOVEM A,DISPON POPJ P, .ENTRY THE-DISPLAY-SLAVE-^F-INTERRUPT SUBR 0003 ;SUBR 2 CN.F: SKIPN DISON SKIPN SIXFIL ;CAUSES SLAVE TO TRY TO GRAB 340 POPJ P, ;IF IT DOESN'T ALREADY HAVE IT PUSHJ P,CLZDIS SETOM DENABL PUSHJ P,DISLEEP JRST YF.MES MOVEI A,.ATOM T MOVEM A,DISON POPJ P, YF.MES: STRT @DERR0(A) POPJ P, .SXEVAL (SSTATUS TTYINT #6 (QUOTE THE-DISPLAY-SLAVE-^F-INTERRUPT)) .SXEVAL (SSTATUS TTYINT #16 (QUOTE THE-DISPLAY-SLAVE-^N-INTERRUPT)) .SXEVAL (SSTATUS TTYINT #31 (QUOTE THE-DISPLAY-SLAVE-^Y-INTERRUPT)) CLZDIS: SETZM DISPON ;(SETQ ^N NIL) SETZ A, EXCH A,DISFIL JUMPE A,CLZDS2 PUSH P,A HRRZ B,.SPECIAL OUTFILES CALL 2,.FUNCTION *DELQ MOVEM A,.SPECIAL OUTFILES HRRZ A,(P) HRRZ B,.SPECIAL ECHOFILES CALL 2,.FUNCTION *DELQ MOVEM A,.SPECIAL ECHOFILES POP P,A CALL 1,.FUNCTION CLOSE CLZDS2: POPJ P, DISLEEP: MOVEI A,DNOOP MOVEM A,DFUNCTION AOS (P) ;SKIPS IF SLAVE IS ALIVE AND WELL MOVEI T,20. ;ELSE, NOSKIP AND LEAVE ERROR NUMBER IN A SKIPL SIXOPD MOVEI T,100. ;FOR PDP10, WAIT UP TO 3.3 SECONDS DISLP3: MOVEI T,1 ;[FOR PDP6, UP TO .6 SECS] FOR SLAVE TO RESPOND .SLEEP T, SKIPE A,ERRLOC DISLP4: SOSA (P) SKIPN DFUNCTION POPJ P, SOJL T,DISLP4 JRST DISLP3 WAITSK: MOVEI F,1111. ;WAITS 1/30TH OF A SECOND, IN FAST MODE XCT (T) SOJN F,.-1 JUMPN F,2(T) MOVEI F,30. ;JDC SAYS 10. ISN'T ENOUGH SKIPL SIXOPD MOVEI F,100. ;SKIP IF XCT'D SKIP WORKS WITHIN SOME WASKP1: JUMPLE F,1(T) ;REASONABLE QUANTUM. BUT NO SKIP IF MOVEI D,1 ;IT DOESN'T .SLEEP D, ;THEN WAITS N 30THS OF A SECOND WASKP2: XCT (T) ;IN SLOW MODE SOJA F,WASKP1 JRST 2(T) CLSSIX: SKIPN SIXOPD POPJ P, LOCKI SETZM DENABL PUSHJ P,DISLEEP MOVEI A,NIL SETZM DISON SETZM SIXOPD .CALL CLSSX7 .VALUE MOVE T,@SIXCHN LSH T,27 IOR T,[.UCLOSE] XCT T SETZM SIXCHN SETZM SIXFIL UNLKPOPJ CLSSX7: SETZ SIXBIT \CORBLK\ ;HACK CORE PAGE 1000,,0 ;DELETE PAGE 1000,,-1 ;FROM ME 402000,,SIXPG ;THIS PAGE OPNSIX: SKIPE SIXOPD POPJ P, MOVE T,[SIXBIT \USR\] PUSHJ P,ALFILE MOVEM A,SIXFIL MOVE TT,F JSP T,FXCONS MOVEM A,SIXCHN LOCKI ;R<0 => SLAVE IS PDP6, >0 => PDP10 MOVNI R,1 ;R=0 => TRYING TO LOAD 6'S MEMORY AND START UP .CALL [ SETZ SIXBIT \OPEN\ 5000,,7 ;IMAGE BLOCK OUTPUT ,,@SIXCHN ;CHANNEL # ,,[SIXBIT \USR\] ;USR DEVICE 1000,,0 ;MY UNAME 400000,,[SIXBIT \PDP6\]] ;JNAME=PDP6 JRST OP10 OP6D2: SKIPN SIXPG JRST OP6D2Q MOVEI TT,1 PUSHJ P,GETCOR SKIPN TT LERR [SIXBIT \NO CORE FOR MAPPING DISPLAY SLAVE!\] MOVE D,[-LFOOTBL,,FOOTBL] ADDM TT,(D) AOBJN D,.-1 LSH TT,-12 MOVEM TT,SIXPG OP6D2Q: .CALL SIXMAP .VALUE OPD62A: MOVEM R,SIXOPD ;IF OPENING 6, THEN R=-1 WILL ALLOW SECOND TRY OP6A: MOVEI TT,DCLEAR ;R = 0 SAYS TRY 10SLAVE IF NO RESPONSE MOVEM TT,DFUNCTION JSP T,WAITSK SKIPE DFUNCTION JRST OP6C AOS DISON SETZM MORFLG SKIPL SIXOPD ;CLEARING WORKED, SO SLAVE IS RUNNING WELL UNLKPOPJ JSP D,OPDSMS ;ANNOUNCE FACT, IF PDP6 WAS GRABBED SETZ [SIXBIT \SLAVE GRABBED^M!\] UNLKPOPJ OP6C: JUMPGE R,OP6B ;ON FIRST FAILURE, TRY TO LOAD DISPLAY FROM DISK .OPEN TMPC,[SIXBIT \ &SYSATSIGN6SLAVE\] OP6C1: LERR DERR1 .CALL [ SETZ SIXBIT \RESET\ 400000,,@SIXCHN ] .VALUE .CALL LSIXC ;LOAD UP SIX .VALUE .CLOSE TMPC, MOVE TT,[JRST 2000] ;IF PDP6 IS RUNNING, IT WILL BE AT LOCATION 41 MOVE T,SIXPG LSH T,12 MOVEM TT,41(T) AOJA R,OP6A SIXMAP: SETZ SIXBIT \CORBLK\ ;HACK CORE PAGE 1000,,300000 ;READ/WRITE ACCESS 1000,,-1 ;MY PAGE ,,SIXPG ;PAGE NUMBER ,,@SIXCHN ;FROM PDP6 401000,,0 ;ITS PAGE 0 OP10: JSP D,OPDSMS [SIXBIT \NOT AVAILABLE!\] JRST OPNTEN OP6B: PUSHJ P,CLSSIX JUMPN R,DERR0 JSP D,OPDSMS [SIXBIT \NOT RUNNING!\] OPNTEN: .CALL [ SETZ SIXBIT \OPEN\ 5000,,6 ;IMAGE BLOCK INPUT ,,@SIXCHN ,,[SIXBIT \USR\] ;USR DEVICE 1000,,0 ;MY UNAME 400000,,[SIXBIT \DSLAVE\]] ;RANDOM JOB .VALUE .OPEN TMPC,[SIXBIT \ &SYSATSIGN10SLAV\] JRST OP6C1 .CALL LSIXC .VALUE .CLOSE TMPC, .CALL SIXMAP .VALUE MOVEM F,XARG ;0 => 340 SLAVE, "TNM" => GT40 SLAVE MOVE T,@SIXCHN LSH T,27 IOR T,[.USET [.SUPC,,[2000]]] ;LOC OF STARTING ADDRESS XCT T MOVE T,@SIXCHN LSH T,27 IOR T,[.USET [.SUSTP,,[0]]] ;BREATHE SOME LIFE INTO SLAVE XCT T MOVEI R,1 ;R=1 SAYS 10SLAVE TAKEN JRST OP6D2 OPDSMS: PUSHJ P,IOGBND STRT [SIXBIT \^MPDP6 !\] STRT @(D) SKIPL (D) ;SKIP FOLLOWING MSG IF ANNOUNCING PDP6 GRABBED STRT [SIXBIT \ TRYING PDP10 SLAVE^M!\] PUSHJ P,UNBIND JRST 1(D) LSIXC: SETZ SIXBIT \LOAD\ ,,@SIXCHN ;TO CHANNEL 401000,,TMPC ;FROM CHANNEL CK6OPN: SKIPE SIXOPD ;QUICK CHECK FOR A WORKING SLAVE JRST (T) PUSH P,T CK6NOPN: SKIPE SIXOPD ;LOOP AROUND THE FAIL-ACT UNTIL SLAVE IS OPENED CCK6NOPN: POPJ P,CK6NOPN DISNOPN: PUSH P,CCK6NOPN ;CAUSES RETRY OF TEST, AND EXIT THRU (T) IF WIN %FAC DERR2 CSENDIT: SKIPN SIXOPD ;CHECK FIRST, THEN SENDIT PUSHJ P,DISNOPN MOVEM R,ARYNUM ;ARYNUM ARGUMENT IN R SENDIT: MOVEM TT,DFUNCTION ;TT=FUNCTION NUMBER SNDT1: AOS (P) ;SKIP IF WIN SNDT1A: JSP T,WAITSK SKIPE DFUNCTION JRST SNDT2 ERRTST: MOVE TT,ARYNUM ;LEAVE ARYNUM IN TT SKIPN D,ERRLOC ;MUST BE AN ERROR POPJ P, ;ERRLOC=0 => NO ERRORS ERTST1: JSP T,FIX1A CALL 1,.FUNCTION NCONS MOVEI B,.ATOM DISPLAY CALL 2,.FUNCTION XCONS SOS (P) ;NO SKIP IF LOSE %FAC @DERR0(D) SNDT2: SKIPE ERRLOC ;COME HERE WHEN THINGS HAVE BEEN GOING ON FOR A LONG TIME JRST ERRTST CAIE TT,DFRAME CAIN TT,MOTION ;TT STILL HAS DFUNCTION IN IT JRST SNDT1A ;MOTION IS ALLOWED TO GO ON FOR EVER SETZB TT,D ;DEAD SLAVE - BOO HOO JRST ERTST1 .ENTRY DISINI LSUBR 1003 ;LSUBR (0 . 2) DISINI: AOJG T,DCLR1 AOJL T,DISTMA SETZ F, JUMPN T,DCLR5 POP P,A PUSHJ P,SIXMAK HLRZ F,TT PUSHJ P,CLSSIX LOCKI PUSHJ P,OPNTEN JRST DCLR5A DCLR5: PUSHJ P,OPNSIX ;GRAB SLAVE IF POSSIBLE DCLR5A: POP P,A ;IF ARGUMENT GIVEN, THEN SET ASTATE JSP T,FXNV1 DCLR3: JUMPL TT,.+2 CAILE TT,3 ;IF ARG NOT IN RANGE 0 - 3, THEN DONT CHANGE ASTATE MOVE TT,ASTATE EXCH TT,ASTATE JRST FIX1 DCLR1: SKIPN SIXOPD JRST DCLR4 MOVEI TT,DCLEAR ;OTHERWISE SIMPLY CLEAR AND INITIALIZE MOVEM TT,DFUNCTION JSP T,WAITSKP SKIPE DFUNCTION JRST SNDT2 JRST DCLR3 DCLR4: SETZ F, PUSHJ P,OPNSIX MOVE TT,ASTATE JRST FIX1 .ENTRY DISCREATE LSUBR 1003 ;LSUBR (0 . 2) DISCREATE: MOVE TT,T JSP T,CK6OPN SETZM XARG SETZM YARG AOJG TT,DSCRT1 AOJN TT,DISTMA POP P,C POP P,B PUSHJ P,DISXY DSCRT1: MOVEI TT,CREATE PUSHJ P,SENDIT POPJ P, ;CUT OUT ON FAILURE JRST FIX1 .ENTRY DISCOPY SUBR 0002 ;SUBR 1 DISCOPY: MOVEI R,DCOPY PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE JRST FIX1 .ENTRY DISBLINK SUBR 0003 ;SUBR 2 DISBLINK: MOVEI R,BLINK ;DISPLAY ALSO ENTERS HERE DISP1: SKIPN B ;ENTER WITH FUN NUMBER IN R, LISP NUM FOR ARYNUM IN A AOSA R ;DISADD ==> DISSUB, BLINK ==> UNBLINK, ETC. DISP1C: MOVEI B,.ATOM T PUSHJ P,DISP1B JFCL MOVEI A,(B) POPJ P, DISP1B: JSP T,FXNV1 ;SKIPS IF ACTION WINS EXCH TT,R ;ARYNUM IN R, FUNCTION IN TT DISXIT: PUSHJ P,CSENDIT POPJ P, ;CUT OUT ON FAILURE DISXT2: AOS (P) POPJ P, .ENTRY DISLINK SUBR 0004 ;SUBR 3 DISLINK: MOVEI R,LINK JSP T,FXNV2 MOVE B,C JRST DSMK1 .ENTRY DISMARK SUBR 0003 ;SUBR 2 DISMARK: MOVEI R,SHOWPEN JSP T,FXNV2 HRLZ B,TT+1 ;IF 2ND ARG IS 0, THEN DO A UNMARK DSMK1: JSP T,CK6OPN MOVEM TT+1,XARG JRST DISP1 .ENTRY DISFRAME SUBR 0002 ;SUBR 1 DISFRAME: JSP T,FXNV1 JSP T,CK6OPN MOVEM TT,WRDCNT MOVEI TT,DFRAME PUSHJ P,SENDIT JFCL MOVEI A,.ATOM T POPJ P, .ENTRY DISET LSUBR 2004 ;LSUBR (1 . 3) DISET: MOVEI F,1 MOVNI TT,2 JSP D,PPBSL MOVEI R,DSET JRST DAL2 .ENTRY DISFLUSH LSUBR 0 ;LSUBR ANY DISFLUSH: MOVEI A,NIL AOJG T,CLSSIX ;(DISFLUSH) SAYS TO FLUSH SLAVE MOVN C,T MOVEI R,DFLUSH ;(DISFLUSH N) SAYS FLUSH DISPLAY ITEM N POP P,A PUSHJ P,DISP1B JFCL SOJGE C,.-3 MOVEI A,.ATOM T POPJ P, .ENTRY DISAPOINT LSUBR 4005 ;LSUBR (3 . 4) DISAPOINT: MOVEI R,DPOINT JRST DAL0 .ENTRY DISALINE LSUBR 4006 ;LSUBR (3 . 5) DISALINE: MOVEI R,DDISALINE DAL0: MOVNI TT,2 MOVEI F,3 JSP D,PPBSL DAL1: POP P,B POP P,A MOVEI T,3 CAMN T,ASTATE JRST DAL3 DAL4: JSP T,FXNV1 JSP T,FXNV2 DAL5: MOVEM TT,XARG MOVEM TT+1,YARG DAL2: POP P,A JRST DISP1C DAL3: JSP T,FLTSKP ;OOPS, POLAR COORDINATES JSP T,DALMES MOVE A,B MOVE TT+1,TT JSP T,FLTSKP JSP T,DALMES EXCH TT,TT+1 JRST DAL5 .ENTRY DISLOCATE SUBR 0004 ;SUBR 3 DISLOCATE: PUSHJ P,DISXY MOVEI R,DMOVE JRST DISP1C DISXY: MOVEI F,XARG ;YARG=XARG+1 DISXY1: JSP T,CK6OPN JSP T,FXNV2 MOVEM D,(F) JSP T,FXNV3 MOVEM R,1(F) POPJ P, DSCLUZ: SUB P,[3,,3] ;LOSE AT DISCUSS POPJ P, .ENTRY DISCUSS LSUBR 5006 ;LSUBR (4 . 5) DISCUSS: MOVEI F,4 MOVNI TT,1 JSP D,PPBSL POP P,A DSCS2: MOVEI TT,0 PUSH P,[DSCLUZ] ;JUST IN CASE MFGWT LOSES JSP T,MFGWT ;SO NOW 6 IS LOCKED OUT OF BUFFER SUB P,[1,,1] HRROI R,DSCS1 MOVNI AR1,BFLNTH*BYTSWD MOVEI AR2A,DBUFFER ;MUST DO IT THIS WAY HRLI AR2A,440700 PUSHJ P,PRINTA MOVEI TT,BFLNTH*BYTSWD(AR1) ;# OF BYTES INSRTED MOVEM TT,WRDCNT MOVEI R,DTEXT SETOM MORFLG JRST DAL1 DSCS1: AOSGE AR1 ;FUNCTION CALLED BY PRINC IDPB A,AR2A POPJ P, PPBSL: SKIPN SIXOPD ;PROCESS OPTIONAL BSL AND PENPOS ARGS PUSHJ P,DISNOPN ;F HOLDS NUMBER OF REQUIRED ARGS ADD F,T ;TT HOLDS - CAML F,TT CAILE F,0 DISTMA: LERR DERR3 ;WNA - DSLAVE PPBSL1: JUMPE F,(D) MOVE A,(P) JUMPE A,PPBSL2 CALL 1,.FUNCTION TYPEP CAIN A,.ATOM LIST JRST PPBSL3 AOJE TT,.+2 ;IF ONLY ONE OPTIONAL PERMITTED, IT MUST BE BSL CAIE A,.ATOM FIXNUM JRST PPBSL4 MOVE A,(P) JSP T,FXNV1 MOVEM TT,PENPOS PPBSL2: SUB P,[1,,1] MOVEI TT,0 AOJA F,PPBSL1 PPBSL3: MOVE A,(P) ;PROCESS A BSL LIST HLRZ A,(A) JSP T,FXNV1 MOVEM TT,DBRITE HRRZ A,@(P) JUMPE A,PPBSL2 HLRZ A,(A) JSP T,FXNV1 MOVEM TT,DSCALE JRST PPBSL2 .ENTRY DISCHANGE SUBR 0004 ;SUBR 3 DISCHANGE: MOVEI F,DBRITE ;DSCALE=DBRITE+1 PUSHJ P,DISXY1 MOVEI R,DCHANGE JRST DISP1C .ENTRY DISMOTION SUBR 0005 ;SUBR 4 DISMOTION: PUSHJ P,DISXY EXCH A,AR1 JSP T,FLTSKP JSP T,IFLOAT EXCH A,AR1 MOVEM TT,WRDCNT MOVEI R,MOTION PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE MOVE D,[-2,,XARG] JRST DSCB1A .ENTRY DISLIST LSUBR 1002 ;LSUBR (0 . 1) DISLIST: AOJG T,DSLS1 JUMPN T,DISTMA POP P,A MOVEI R,DLISTINF PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE JRST DSLS2 DSLS1: MOVEI TT,DLIST PUSHJ P,CSENDIT POPJ P, ;CUT OUT ON FAILURE DSLS2: MOVN D,XARG JUMPE D,DSLS2Q HRLI D,DBUFFER MOVSS D JRST DSCB1A DSLS2Q: SETZ A, POPJ P, .ENTRY DISCRIBE SUBR 0002 ;SUBR 1 DISCRIBE: MOVEI R,WHERE PUSHJ P,DISP1B POPJ P, ;CUT OUT ON FAILURE MOVEI D,DBUFFER ;MUST DO IT THIS WAY HRLI D,-10 DSCB1A: MOVEI B,NIL HLRE R,D DSCB1: MOVE TT,(D) JSP T,FIX1A PUSH P,A AOBJN D,DSCB1 MOVE T,R JCALL 16,.FUNCTION LIST MFGWT: SKIPN MORFLG ;MORFLG WAIT - I.E., WAIT UNTIL MORFLG GOES TO ZERO JRST (T) PUSH P,T JSP T,WAITSK SKIPE MORFLG CAIA POPJ P, SUB P,[1,,1] AOS (P) JRST SNDT2 .ENTRY DISGORGE SUBR 0002 ;SUBR 1 DISGORGE: JSP T,CK6OPN JSP T,MFGWT SETOM MORFLG JSP T,FXNV1 MOVEM TT,ARYNUM HRLOI R,DSEND HLRZM R,DFUNCTION JSP T,MFGWT MOVE TT,WRDCNT PUSH P,[DSGQX1] PUSH P,[NIL] PUSH P,[.ATOM FIXNUM ] PUSH FXP,TT MOVEI A,(FXP) PUSH P,A MOVNI T,3 JCALL 16,.FUNCTION *ARRAY DSGQX1: SUB FXP,[1,,1] HRRZ R,TTSAR(B) MOVE TT,WRDCNT DSGRG1: JSP T,MFGWT CAIG TT,BFLNTH SKIPA F,TT MOVEI F,BFLNTH ADDI F,-1(R) HRLI R,DBUFFER BLT R,(F) MOVEI R,1(F) HRREI TT,-BFLNTH(TT) JUMPLE TT,CPOPJ SETOM MORFLG JRST DSGRG1 DSGQX4: SUB P,[1,,1] WTA [BAD ARG - DISGOBBLE!] .ENTRY DISGOBBLE SUBR 0002 ;SUBR 1 DISGOBBLE: PUSH P,A CALL 1,.FUNCTION TYPEP CAIN A,.ATOM ARRAY JRST DSGQX3 HRRZ A,(P) MOVEI A,.ATOM ARRAY CALL 2,.FUNCTION GET JUMPE A,DSGQX4 DSGQX3: SUB P,[1,,1] JSP T,MFGWT MOVE R,ASAR(A) HLRE TT,-1(R) HRRZ R,-1(R) MOVNS TT MOVEM TT,WRDCNT MOVEI F,DGET MOVEM F,DFUNCTION DSGBL1: CAIG TT,BFLNTH SKIPA F,TT MOVEI F,BFLNTH MOVEI T,DBUFFER HRL T,R ADD R,F ADDI F,DBUFFER SUBI F,1 ;MUST DO IT THIS WAY BLT T,(F) HRREI TT,-BFLNTH(TT) SETOM MORFLG JSP T,MFGWT JUMPG TT,DSGBL1 PUSHJ P,SNDT1 POPJ P, ;CUT OUT ON FAILURE JRST FIX1 DERR1: SIXBIT \DSLAVE FILE MISSING!\ DERR2: SIXBIT \DISPLAY SLAVE HAS NOT BEEN OPENED!\ DERR3: [SIXBIT \WRONG NUMBER OF ARGS TO SOME FUNCTION - DSLAVE!\] DALMES: WTA [FLONUM ARG REQUIRED - DISPLAY SLAVE!] JRST -1(T) PPBSL4: MOVE A,(P) WTA [BAD ARG TO SOME DISPLAY FUN!] JRST PPBSL1 DERR0: LERR [SIXBIT \SLAVE HAS DIED!\] DERR: LERR [SIXBIT \TOO MANY DISPLAY ITEMS!\] ;TABLE OF ERRORS LERR [SIXBIT \DISPLAY MEMORY FULL!\] ;RETURNED FROM SLAVE LER3 [SIXBIT \ UNKNOWN DISPLAY ITEM!\] LERR [SIXBIT \ENORMOUS VECTOR!\] LERR [SIXBIT \BAD RELATIVE VECTOR - DSLAVE!\] LERR [SIXBIT \BAD FUNCTION - DSLAVE!\] LERR [SIXBIT \340 NOT AVAILABLE!\] LER3 [SIXBIT \ HAS TOO MANY DISPLAY INFERIORS!\] FASEND ;;; -*-MIDAS-*- TITLE TEST VERPRT .FASL DEFINE DOZZM CHAR,N,NP1 DEFINE ZZ!NP1 ZZ!N!!CHAR!TERMIN TERMIN DEFINE VERPRT NAME,VRS=[???] IFN .FNAM2-SIXBIT /MID/,[ REPEAT 6,[ IRPNC <77&<.FNAM2_<6*<5-.RPCNT>>>>,1,1,CHAR,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_] DOZZM CHAR,\.RPCNT,\<1+.RPCNT> TERMIN ] CONC [VRPRT1 NAME,]ZZ6 ] .ELSE [ VRPRT1 NAME,VRS ] TERMIN DEFINE VRPRT1 NAME,VRS .SXEVAL (PROG2 (COND ((STATUS NOFEATURE NOLDMSG) (TERPRI MSGFILES) (TYO #73 MSGFILES) (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/ VRS) MSGFILES) (TYO #40 MSGFILES))) (DEFPROP NAME VRS VERSION)) TERMIN ;; Silent VERPRT, which doesn't print the message, just does the DEFPROP ;; of the version property DEFINE SVERPRT NAME,VRS=[???] IFN .FNAM2-SIXBIT /MID/,[ %%%==.fnam2 .SXEVAL (PUTPROP (QUOTE NAME) (MAKNAM (DELQ #40 (QUOTE (#<<<%%%&<770000,,0>>_-36>+40> #<<<%%%&<7700,,0>>_-30>+40> #<<<%%%&<77,,0>>_-22>+40> #<<<%%%&770000>_-14>+40> #<<<%%%&7700>_-6>+40> #<<%%%&77>+40> )))) (QUOTE VERSION)) ] .ELSE [ .SXEVAL (DEFPROP NAME VRS VERSION) ] TERMIN VERPRT A FASEND );;; -*-MIDAS-*- TITLE TEST VERPRT .FASL DEFINE DOZZM CHAR,N,NP1 DEFINE ZZ!NP1 ZZ!N!!CHAR!TERMIN TERMIN DEFINE VERPRT NAME,VRS=[???] IFN .FNAM2-SIXBIT /MID/,[ %%%==.fnam2 .SXEVAL ((LAMBDA (UGLY) (COND ((STATUS NOFEATURE NOLDMSG) (TERPRI MSGFILES) (TYO #73 MSGFILES) (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/ ) MSGFILES) (PRINC UGLY MSGFILES) (TYO #40 MSGFILES))) (PUTPROP (QUOTE NAME) UGLY (QUOTE VERSION))) (MAKNAM (DELQ #40 (QUOTE (#<<<%%%&<770000,,0>>_-36>+40> #<<<%%%&<7700,,0>>_-30>+40> #<<<%%%&<77,,0>>_-22>+40> #<<<%%%&770000>_-14>+40> #<<<%%%&7700>_-6>+40> #<<%%%&77>+40> ))))) ] .ELSE [ .SXEVAL (COND ((STATUS NOFEATURE NOLDMSG) (TERPRI MSGFILES) (TYO #73 MSGFILES) (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/ VRS/ ) MSGFILES))) .SXEVAL (DEFPROP NAME VRS VERSION) ] TERMIN ;; Silent VERPRT, which doesn't print the message, just does the DEFPROP ;; of the version property DEFINE SVERPRT NAME,VRS=[???] IFN .FNAM2-SIXBIT /MID/,[ %%%==.fnam2 .SXEVAL (PUTPROP (QUOTE NAME) (MAKNAM (DELQ #40 (QUOTE (#<<<%%%&<770000,,0>>_-36>+40> #<<<%%%&<7700,,0>>_-30>+40> #<<<%%%&<77,,0>>_-22>+40> #<<<%%%&770000>_-14>+40> #<<<%%%&7700>_-6>+40> #<<%%%&77>+40> )))) (QUOTE VERSION)) ] .ELSE [ .SXEVAL (DEFPROP NAME VRS VERSION) ] TERMIN ;MACRO TO HANDLE UNWIND-PROTECT