From 88bf6d0461a5a32e3502299e623cf5f144172a7a Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 15 May 2018 11:39:32 +0200 Subject: [PATCH] LD10, Lisp display slave. --- build/lisp.tcl | 13 + doc/programs.md | 1 + src/l/slave.8 | 730 +++++++++++ src/sysen2/ld10.61 | 2887 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 3631 insertions(+) create mode 100644 src/l/slave.8 create mode 100755 src/sysen2/ld10.61 diff --git a/build/lisp.tcl b/build/lisp.tcl index 15e09164..6c84e05a 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -793,3 +793,16 @@ respond "*" ":link liblsp;vsaid fasl,lisp;\r" respond "*" ":midas liblsp;_gsb;ttyvar\r" respond "Use what filename instead?" "lisp;\r" expect ":KILL" + +# Lisp display library +respond "*" ":midas lisp; slave fasl_l; slave\r" +expect ":KILL" + +# Lisp display slave, PDP-6 and PDP-10 versions. +respond "*" ":midas sys; atsign 6slave_sysen2; ld10\r" +respond " PDP6F = " "1\r" +expect ":KILL" +respond "*" ":midas sys; atsign 10slav_sysen2; ld10\r" +respond " PDP6F = " "0\r" +respond "GT40F=" "0\r" +expect ":KILL" diff --git a/doc/programs.md b/doc/programs.md index a8bd9746..44954741 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -86,6 +86,7 @@ - JOBS, list jobs by category. - JOTTO, word-guessing game. - LAY, SUDS layout program. +- LD10, Lisp display slave. - LIMERI, print limerics. - LIMSER, Chaosnet limeric service. - LISP, lisp interpreter and runtime library (autoloads only). diff --git a/src/l/slave.8 b/src/l/slave.8 new file mode 100644 index 00000000..af41ebb3 --- /dev/null +++ b/src/l/slave.8 @@ -0,0 +1,730 @@ + +;;; ************************************************************** +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 +  diff --git a/src/sysen2/ld10.61 b/src/sysen2/ld10.61 new file mode 100755 index 00000000..7346d6dd --- /dev/null +++ b/src/sysen2/ld10.61 @@ -0,0 +1,2887 @@ +;LISP Display Slave for PDP10 and PDP6 +;June 1973, Jerome Lerman +;GT40 additions and other updating December 1973, Joseph D. Cohen + +;COMPLETE BITEAGE OF THE BAG BY ALL CONCERNED, COMMENT BY TK +;THIS PROGRAM REALLY ... I LACK WORDS. + +;IF PDP6F=1, ASSEMBLE A VERSION TO RUN ON PDP6 +;IF PDP6F=0, ASSEMBLE A VERSION TO RUN UNDER ITS +;IF GT40F=1, ASSEMBLE A GT40 VERSION FOR ITS + +IF1 [ PRINTX /IF PDP6F = 0, ASSEMBLE A PDP10 VERSION +IF PDP6F =1, ASSEMBLE A PDP6 VERSION + PDP6F = / +.TTYMAC A +IFB A,[A=0 +] ;DEFAULT IS PDP10 VERSION +PDP6F=A +IFN PDP6F,PDP6F==1 +TERMIN +GT40F==0 ;IF NZ, GT40 SLAVE + +IFE PDP6F,[PRINTX /1=>GT40 VERSION + GT40F=/ +.TTYMAC A +IFB A,[A=0 +] ;DEFAULT IS NON GT40 +GT40F==A +IFN GT40F,GT40F==1 +TERMIN ] +] + + +IFE PDP6F+GT40F,[TITLE 340 SLAVE FOR PDP10 +] +IFN GT40F,[TITLE GT40 SLAVE FOR PDP10 +] +IFN PDP6F,[TITLE DISPLAY SLAVE FOR PDP6 +] + +ZR=0 + +A=1 ;USUALLY CONTAINS ARRAY NUMBER +B=2 +C=3 +D=4 +E=5 +F=6 +G=7 + +T=10 +U=11 ;USUALLY CONTAINS FLAGS +V=12 +W=13 +X=14 +Y=15 +Z=16 + +P=17 ;PDL POINTER + + +LPDL==200. + +IFN GT40F,[ +GICH==1 ;CHANNEL FOR INPUT FROM GT40 +GOCH==2 ;OUTPUT TO GT40 +] + +IFN PDP6F,[ +TTY==120 ;TELETYPE +DIS==130 ;340 SCOPE +PDP==20 ;INTERPROCESSOR + +IORSET=633550 + +CLCH==3 ;CLOCK CHANNEL +PDCH==4 ;INTERPROCESSOR CHANNEL +FLGCH==5 ;DISPLAY FLAG CHANNEL +DISCH==6 ;DISPLAY DATA CHANNEL + +DDT=34000 ;DDT'S STARTING ADDRESS +MEMSIZ==40000 ;SIZE OF PDP6 MEMORY +] + +;ARRAY ZERO IS ALWAYS THE LISTS OF LINKS + + +;ASSORTED MACROS + +DEFINE ROUND AX + FAD AX,[0.5] + MULI AX,400 + TSC AX,AX + ASH ,-243(AX) +TERMIN + + +DEFINE FIX AX,AY + MULI AX,400 + TSC AX,AX + ASH ,AY-243(AX) +TERMIN + +DEFINE ROUND AX + FAD AX,[0.5] + FIX AX,0 +TERMIN + +DEFINE FLOAT AX,AY + TLC AX,232000+1000*AY + FADR AX,AX +TERMIN + + +;INTERRUPT LOCATIONS FOR PDP6 VERSION + +IFN PDP6F,[ + + LOC 40+2*FLGCH + JSR FLGBRK + JSR REDIS + + LOC 40+2*DISCH + BLKO DIS,BLKOP + CONO PI,4000+200_- ;CAUSE FLGCH INTERRUPT (2ND WD) + + LOC 40+2*CLCH + JSR CLOCK + + LOC 40+2*PDCH + JRST 10,REGO ;AN INTERRUPT FROM PDP10 WILL RESTART THE SLAVE +] + + +;INTERRUPT FOR PDP10/GT40 + +IFN GT40F,[ + LOC 42 + JSR GINT +] + +;PAGE OF VARIABLES TO BE APPENDED BY SUPERIOR + +LOC 100 + +DENABL: -1 ;-1=>DISPLAY ON, 0=>DISPLAY OFF + +FUNCTION: 0 ;FUNCTION NUMBER (SET BY SUPERIOR) +ERRLOC: 0 ;ERROR NUMBER (READ BY SUPERIOR) +ASTATE: 0 ;0=>X AND Y ARE RELATIVE TO HOME POSITION + ;1=>XARG AND YARG ARE IN ABSOLUTE COORDINATES + ;2=>X AND Y ARE INCREMENTAL + ;3=>POLAR COORDS; XARG=RADIUS YARG=ANGLE (DEGREES) + +ARYNUM: 0 ;ARRAY NUMBER +XARG: 0 ;X ARGUMENT +YARG: 0 ;Y ARGUMENT +PENPOS: 0 ;-1=>PUT PEN DOWN + ;0=>LEAVE PEN IN CURRENT POSITION + ;+1=>LIFT PEN +DBRITE: 0 ;0=>NO CHANGE IN BRIGHTNESS + ;-7 TO 7 => INCREASE BRIGHTNESS BY THAT AMOUNT +DSCALE: 0 ;0=>NO CHANGE IN SCALE + ;-3 TO 3 => INCREASE SCALE BY THAT AMOUNT +WRDCNT: 0 ;# OF WORDS IN A TRANSFER OR # OF CHARACTERS IF TEXT +MORFLG: 0 ;MORFLG=0 LOCKS PDP6 OUT OF BUFFER + ;MORFLG=-1 LOCKS PDP10 OUT OF THE BUFFER +BFLNTH==1776-. ;BUFFER GOES FROM HERE TO LOCATION 1776 +MAXCHR==BFLNTH*5 ;5 ASCII CHARACTERS PER WORD +BUFFER: BLOCK BFLNTH ;BUFFER GOES ALMOST TO END OF THIS PAGE + +START==2000 + +LOC START + +;START OF MAIN PROGRAM + +GO: SETZM FUNCTION +IFE PDP6F,[ SETZM DISLIS +] +IFN PDP6F,[ + HRLZI A,(CONO) + MOVEI B,177 + XCT A ;CONO ALL DEVICES ZERO + ADD A,[400,,0] + SOJGE B,.-2 + + MOVE A,[JSR REDIS] + MOVEM A,41+2*FLGCH +] + +REGO: MOVE P,[-LPDL,,PDL-1] + + SETZM ERRLOC + SETOM DENABL ;TRY TO GET SCOPE + SETZM SCPSTE ;SCOPE INITIALLY OFF + PUSHJ P,DSTART ;TRY TO SEIZE DISPLAY + CONO 420,40 ;ENABLE SPACE WAR CONSOLES + +IFN PDP6F,[ + CONO IORSET+CLCH ;RESET PROCESSOR + CONO PDP,PDCH ;SET UP PROCESSOR INTERRUPT +] + + SETZM DBRITE ;INITIALIZE CONTROL LOCATIONS + SETZM DSCALE + SETZM PENPOS + SETZM ASTATE ;SLAVE IS INITIALLY IN RELATIVE MODE + SETZM ARYNUM + SETOM SUPFLG ;NO INFERIORS (FOR DCOPY) + + MOVE W,[JRST GETMOD] + MOVEM W,PSWIT + MOVE W,[MSKIP] + MOVEM W,MODTBL+1 + +IFN GT40F,[ MOVE G,XARG + MOVEM G,GTTY + PUSHJ P,GTCLR ;CLEAR SCREEN +] +IFN PDP6F,[;ENABLE INTERRUPTS + CONO PI,12200+200_-++200_-+200_-+200_- +] + +;MAIN LOOP SCANS ARRAYS AND SHUFFLES OUT HOLES +IFE PDP6F,[ +MAIN0: SKIPN FUNCTION + .HANG ;WAIT UNTIL FUNCTION IS NON-ZERO + PUSHJ P,PDPBK ;DO A FUNCTION + PUSHJ P,SHUFEL ;SHUFFLE OUT HOLES + JRST MAIN0 +] +IFN PDP6F,[ +;MAIN0: SKIPE FUNCTION +; PUSHJ P,PDPBK ;DO A FUNCTION +; PUSHJ P,SHUFEL ;SHUFFLE OUT HOLES +; JRST MAIN0 + +MAIN0: SKIPN FUNCTION + JRST MAIN1 + SETZM TIME + PUSHJ P,PDPBK ;DO FUNCTION + MOVE G,TIME ;ELAPSED TIME FOR FUNCTION + MOVEM G,FTIME + CAMLE G,MFTIME ;LONGEST TIME TO DO FUNCTION + MOVEM G,MFTIME +MAIN1: PUSHJ P,SHUFEL + JRST MAIN0 + +FTIME: 0 +MFTIME: 0 +] + +;ROUTINE TO SHUFFLE OUT SPACE BETWEEN ARRAYS +SHUFEL: MOVEI C,FS + HRRE F,ARYLP ;GET LOWEST + JRST SHUF2 +SHUF1: CAME C,ARYORG(F) + PUSHJ P,ARYMVD ;MOVE IT DOWN IF THERE'S ROOM + ADD C,ARYL(F) + HRRE F,ARYF(F) ;INDEX OF NEXT +SHUF2: JUMPGE F,SHUF1 ;NO, CONTINUE SHUFFLING + POPJ P, + + +;INTERUPT LEVEL CODE FOR PDP6 VERSION + +IFN PDP6F,[ + +;DO SOMETHING ABOUT EDGE FLAGS +FLGBRK: 0 ;HERE AFTER FLAG INTERRUPT + AOSN TOUTF' ;TIME OUT FLAG SET? + JRST REDIS1 ;PRETEND WE RAN OUT OF BLKO POINTER STUFF + MOVEM A,SAVA + CONI DIS,A + TRNN A,7000 ;VERT EDGE, LP, HORIZ EDGE + CONO DIS,100 ;INITIALIZE + ANDI A,77 + CONO DIS,10200(A) ;RESUME + MOVE A,SAVA + JRST 12,@FLGBRK + +SAVA: 0 +SAVB: 0 + +REDIS1: EXCH A,FLGBRK + MOVEM A,REDIS + MOVE A,FLGBRK + JRST ENDLIS ;PRETEND WE GOT TO END OF LIST INSTEAD OF HUNG + +;FLAG CHANNEL 2ND WD +REDIS: 0 ;RE-DISPLAY + MOVEM A,SAVA + MOVEM B,SAVB + SKIPGE A,DPNTR + JRST ENDLIS ;END OF LIST +RED1: SKIPL B,ARYF(A) ;GET POINTER AND FLAGS + JRST NOTON ;NOT ON DISPLAY + TDNN B,BSTATE + CONO DIS,4000+FLGCH_3+DISCH ;TURN ON INK + TDNE B,BSTATE ;IF BLINKING, KILL THE INK + CONO DIS,2000+FLGCH_3+DISCH ;NO INK FOR THIS ONE + HRREM B,DPNTR ;POINT TO NEXT + SKIPN B,ARYMPP(A) ;GET BLKO POINTER + JRST NOTON ;BLKO POINTER IS ZERO + MOVEM B,BLKOP + MOVE A,[JSR FOOBRK] +RED4A: MOVEM A,40+2*DISCH +RED4: MOVE A,SAVA + MOVE B,SAVB + JRST 12,@REDIS + +NOTON: HRRE A,B ;MAKE IT -1, IF IT IS END + SKIPL A ;GET POINTER TO NEXT INTO A + JRST RED1 ;NOT END OF LIST, SO DO IT + +ENDLIS: SKIPN CONTIN ;END OF LIST + JRST RED6 ;IN ONE SHOT MODE + SKIPL A,ARYLP ;GET BEGINNING OF LIST + JRST RED1 ;SOMETHING THERE, SO DO IT + JRST 4,. + +RED6: MOVE A,[JSR PNTBRK] + JRST RED4A ;AND RETURN + +DPNTR: ,,-1 +BLKOP: 0 ;BLKO POINTER FOR DISPLAY +CONTIN: -1 ;0=>DO LIST ONCE AND STOP + +;MORE PDP6 INTERRUPT CODE + +PNTBRK: 0 + DATAO DIS,[20117,,220000] ;MOVE DOT TO LOWER-LEFT CORNER + JFCL + DATAO DIS,[0,,403737] + JFCL + PUSHJ P,DSTOP ;STOP DISPLAY + SETOM CONTIN ;TURN CONTIN BACK ON + JRST 12,@PNTBRK + +FOOBRK: 0 ;FAKE OUT 340 + MOVEM A,FOSAVA + MOVE A,[BLKO DIS,BLKOP] + MOVEM A,40+2*DISCH + MOVE A,FOSAVA + JRST 12,@FOOBRK + +FOSAVA: 0 + +;CLOCK HANDLER + +CLOCK: 0 + MOVEM C,CSAVC + + CONSO 10000 + JRST CLOCK1 + JRST 4,.+1 ;NXM + CONO 10000 +CLOCK1: CONSZ 200000 + JRST PIDLOV + + CONO 1000+CLCH + AOS TIME + AOS C,TOUT' + CAIL C,5 ;TIMED OUT? + JSP C,TOUT1 ;YES + SOSG TIMER ;TIMED OUT? + JRST TIMOUT ;YEP +CLK1: MOVE C,CSAVC ;RESTORE + JRST 12,@CLOCK + +CSAVC: 0 + +TOUT1: SETZM TOUT + SKIPL SCPSTE + JRST (C) ;SCOPE NOT ON + SETOM TOUTF' + CONO DIS,100+FLGCH_3+DISCH + CONO PI,4000+200_- + AOS TOUTC' ;TIME OUT COUNT + JRST (C) + +TIME: 0 +TIMER: 0 +BSTATE: 0 ;0=>BLINK OFF, 1=>BLINK ON + +TIMOUT: MOVE C,BSTATE ;GET BLINK STATUS + TLC C,BLINKB ;AND CHANGE STATE + MOVEM C,BSTATE + MOVE C,BRATE + MOVEM C,TIMER ;RESET TIMER + JRST CLK1 + +BRATE: 10. ;BLINK EVERY 10/30 OF A SECOND + +PIDLOV: CONO 400000 + MOVEM P,QUITP + MOVE P,[-LPDL,,PDL-1] + JRST INTERR ;SLAVE GOOFED +QUITP: 0 + +] + +;HERE TO EVALUATE A FUNCTION +PDPBK: MOVEM P,PSAVAC ;SAVE PDL POINTER + SETZM ERRLOC ;START WITH NO ERROR + MOVE B,ARYNUM + MOVEM B,SAVARY ;FOR DEBUGGING + MOVE B,FUNCTION + MOVEM B,SAVFUN + CAIL B,FNUM + PUSHJ P,FERR ;ERROR - THAT FUNCTION DOESN'T EXIST + CAIN B,6. ;IS IT A DCLEAR? + SETZM ARYNUM ;YES, IGNORE ARYNUM + CAIN B,24. ;IS IT DLIST + SETZM ARYNUM ;YES, IGNORE ARYNUM + CAIN B,26. ;IS IT FRAME? + SETZM ARYNUM ;YES, IGNORE ARYNUM + MOVE A,ARYNUM ;GET ARRAY NUMBER + MOVE U,ARYF(A) ;GET THE FLAGS + PUSHJ P,@FTAB-1(B) ;YUP,SO DO IT + +FDONE: MOVE P,PSAVAC + SETZM DBRITE + SETZM DSCALE + SETZM PENPOS + SETZM FUNCTION ;WAIT FOR NEXT CALL + POPJ P, + +PSAVAC: 0 ;SAVE PDL POINTER +SAVFUN: 0 ;LAST FUNCTION +SAVARY: 0 ;ARRAY + +;TABLE FOR FUNCTION DISPATCHING + +;DURING MOST OF THESE FUNCTIONS, THE ARRAY INDEX IS KEPT IN A, +; AND THE FLAGS ARE IN U + +FTAB: CREATE ;#1 =>CREATE AND INITIALIZE A DISPLAY ARRAY + DISADD ;#2 =>PUT GIVEN DISPLAY ARRAY ON DISLIST + DISSUB ;#3 =>REMOVE GIVEN DISPLAY ARRAY FROM DISLIST + DFLUSH ;#4 =>EXPUNGE GIVEN ARRAY + DISALINE ;#5 =>DISPLAY LINE SEGMENT + DCLEAR ;#6 =>RE-INITIALIZE DISPLAY PROCESSOR + DMOVE% ;#7 =>SHIFT A DISPLAY ITEM + DGET ;#8 =>GET A DISPLAY ARRAY FROM SUPERIOR + DSEND ;#9 =>SEND A DISPLAY ARRAY TO SUPERIOR + BLINK ;#10 =>CAUSE A DISPLAY ITEM TO BLINK + UNBLINK ;#11 =>CAUSE AN ITEM TO STOP BLINKING + DCHANGE ;#12 =>CHANGE BRIGHTNESS AND/OR SCALE + DTEXT ;#13 =>INSERT TEXT AT (XARG,YARG) LEAVING PEN AT +;(XARG,YARG) WHEN FINISHED. PEN STATE IS UNCHANGED BY DTEXT. + DCOPY ;#14 =>MAKE A COPY OF A DISPLAY ITEM. THE ARRAY +;NUMBER OF THE NEW ITEM IS RETURNED IN ARYNUM. THE NEW ITEM IS NOT +;ADDED TO THE DISPLAY. + WHERE ;#15 =>RETURNS HOME POSITION IN XARG (X,,Y) +;AND CURRENT POSITION IN YARG (X,,Y) + DPOINT ;#16 =>DISPLAY A POINT + SCOPE ;#17 =>SEIZE OR RELEASE 340 + SHOWPEN ;#18 =>SHOW PEN POSITION IN ARRAY NAMED + HIDEPEN ;19. => REMOVE PEN MARKER FROM NAMED ARRAY + LINK ;#20. =>LINK ARYNUM AND XARG + UNLINK ;#21. =>UNLINK ARYNUM AND XARG. IF XARG=-1, UNLINK +;ARYNUM FROM ALL LINKS + MOTION ;#22. =>MOVE ARRAY ARYNUM VIA SPACE WAR CONSOLE + LISTINF ;#23. =>LIST INFERIORS OF SPECIFIED ITEM + DLIST ;#24.=>LIST ALL ITEMS ON DISPLAY + DSET ;#25. =>CHANGE GLOBAL VALUES OF PENPOS,BRIGHTNESS AND SCALE + FRAME ;#26. =>EXPOSE FRAMES ON MOVIE CAMERA +FNUM==.-FTAB+1 + +;TABLE OF ERROR ROUTINES +;FATAL ERRORS CAN BE CALLED WITH PUSHJ P, + +ARRFUL: MOVEI W,1 ;1=>TOO MANY DISPLAY ARRAYS +FATAL: MOVEM W,ERRLOC + POP P,ERSPOT ;FOR DEBUGGING + MOVEM P,ERPDL + JRST FDONE ;ABORT FUNCTION AND RETURN + +MEMFUL: MOVEI W,2 ;2=>NO MORE ROOM IN MEMORY + JRST FATAL ;ABORT FUNCTION + +NOARY: MOVEM A,ARYNUM ;TELL HIM WHICH ARRAY IS THE OFFENDER + MOVEI W,3 ;3=>ACCESSED NON-EXISTANT DISPLAY ARRAY + JRST FATAL ;ABORT FUNCTION + +INTERR: MOVEI W,5 ;5=>INTERNAL ERROR + JRST FATAL ;ABORT FUNCTION + +FERR: MOVEI W,6 ;6=>BAD FUNCTION + JRST FATAL + +NOTFLT: MOVEI W,9. ;9 =>IN POLAR MODE, ARGS AREN'T FLOATING POINT + JRST FATAL + +ERSPOT: 0 ;ONE PAST WHERE ERROR OCCURED +ERPDL: 0 + +;NON-FATALITIES +NO340: SETZM DENABL ;DON'T KEEP TRYING + MOVEI W,7 ;7=>340 NOT AVAILABLE + JRST DIAG ;TELL HIM + +BIGVEC: MOVEI W,4 ;4=>GIGANTIC VECTOR +DIAG: MOVEM W,ERRLOC + POPJ P, + + +;ROUTINES TO PERFORM REQUESTED DISPLAY FUNCTIONS +; A ALWAYS CONTAINS ARRAY NUMBER (SET BY PDPBK) + +;CREATE A DISPLAY ITEM -- FUNCTION #1. +; FIRST 3 HALFWORDS OF DISPLAY ARRAY ARE FIXED BY CREATE +; 1) SCALE AND BRIGHTNESS PARAMETER MODE WORD +; 2) Y HOME POSITION POINT MODE WORD +; 3) X HOME POSITION POINT MODE WORD + +CREATE: SETOM A + MOVEI B,15. ;INITIAL BUFFER LENGTH = 15. +DISIN1: PUSHJ P,ARYALS ;GET ARRAY + MOVEM A,ARYNUM ;REMEMBER FOR SUPERIOR +DISIN2: MOVE B,ARYORG(A) + HRLI B,442200 + MOVEM B,BYTPNT(A) ;BYTE POINTER INTO DISPLAY ARRAY + SUBI B,2 ;LEAVE SOME EXTRA ROOM AT THE END + ADD B,ARYL(A) + HRRZM B,DSPLIM(A) ;UPPER LIMIT, LAST WORD + MOVEI B,347 ;INITIALIZE SCALE, INTENSITY BITS, SET MODE TO PARAMETER + HRRZM B,BSTORE(A) ;INITIALIZE BSTORE WORD + MOVEI W,117 ;SCALE 0, INT 7-MAY LOOSE IF TRY TO IMMEDIATLY CHANGE INT + PUSHJ P,DSPPTZ + SETZM LPNTR(A) ;CREATED ARRAY HAS NO LINKS + HRLI U,PENBIT ;PEN IS INITIALLY DOWN + HLLM U,ARYF(A) + MOVE B,XARG + MOVE C,YARG + ANDI B,DSPMSK + ANDI C,DSPMSK + MOVEM B,XDISP(A) + MOVEM C,YDISP(A) +IFN GT40F,PUSHJ P,GINAR ;INITIALIZE ARRAY + PUSHJ P,DSPPNZ ;DISPLAY AN INVISIBLE POINT + JRST IDISADD ;ITEM IS INITIALLY ON + +;ADD ARYNUM TO DISPLAY LIST - LINKABLE -- FUNCTION #2. + +DISADD: PUSHJ P,ATEST +IDISAD: TLO U,BDISB ;SET FLAG + HLLM U,ARYF(A) +IFE PDP6F,[ PUSHJ P,DADD +] + PUSHJ P,DOLINK ;IF THERE ARE LINKS, DO THEM + PUSHJ P,DOMARK ;IF THERE IS A MARKER, DO IT TOO + JRST DSTART ;START IT IF NOT ALREADY ON + +IFE PDP6F,[ +DADD: +IFN GT40F,PUSHJ P,GSHW ;SHOW GT40 LIST + MOVEI C,DISLIS(A) + MOVEI D,DISLIS +DADD1: HRRZ B,(D) ;LOOK AT RIGHT HALF OF WORD + SKIPN B + JRST DADD2 ;END OF LIST + CAMN B,C + POPJ P, ;ALREADY ON + MOVE D,B + JRST DADD1 + +DADD2: HRRM C,(D) + HRLZI B,ARYMPP(A) ;ADD BLKO POINTER TO LIST + MOVEM B,DISLIS(A) + POPJ P, +] + +;REMOVE ARYNUM FROM DISPLAY LIST - LINKABLE -- FUNCTION #3. + +DISSUB: PUSHJ P,ATEST +IFE PDP6F,[ PUSHJ P,DSUB +] +IFN PDP6F,[ + TLZ U,BDISB + HLLM U,ARYF(A) +] + PUSHJ P,DOLINK ;IF THERE ARE LINKS, DO THEM +IFE PDP6F,[ JRST DOMARK ;IF THERE IS A MARKER, DO IT TOO +] +IFN PDP6F,[ + PUSHJ P,DOMARK + JRST RESTART ;RESTART DISPLAY +] + +IFE PDP6F,[ +DSUB: +IFN GT40F,PUSHJ P,GERS ;DON'T SHOW ARRAY IN GT40 + TLZ U,BDISB ;TURN OFF FLAG + HLLM U,ARYF(A) + MOVEI D,DISLIS + CAIN D,DISLIS(A) + JRST DSUB1 ;ITEM TO BE REMOVED IS FIRST ON LIST + MOVEI C,DISLIS(A) +DSUB2: HRRZ B,(D) ;GET RIGHT HALF + SKIPN B + POPJ P, ;END OF LIST AND DIDN'T FIND IT + CAMN B,C ;DO I POINT TO IT + JRST DSUB3 ;YES, SPLICE OUT ITEM + MOVE D,B ;NO GET NEXT + JRST DSUB2 + +DSUB1: HRRZ B,DISLIS(A) + SKIPN B + PUSHJ P,DSTOP ;TURN OFF DISPLAY + HRRZM B,DISLIS + POPJ P, + +DSUB3: MOVE B,DISLIS(A) ;REMOVE ITEM FROM DISPLAY + HRRM B,(D) + POPJ P, +] + + +;ERASE AN ARRAY FROM MEMORY - LINKABLE -- FUNCTION #4. + +DFLUSH: PUSHJ P,ATEST +IFE PDP6F,[ + SETZM ARYMPP(A) ;SET BLKO POINTER TO ZERO +IFN GT40F,PUSHJ P,GDEL ;DELETE FROM GT40 + PUSHJ P,DSUB +] +IFN PDP6F,[ + TLZ U,BDISB + HLLM U,ARYF(A) + PUSHJ P,RESTART ;RESTART DISPLAY +] + + PUSHJ P,DOMARK ;IF THERE IS A MARKER, FLUSH IT + PUSHJ P,ARYDEL ;DELETE THE ARRAY + + HRRE F,ARYLP ;DELETE ANY REFERENCE TO ME AS A MARKER + JRST DF4+1 +DF3: MOVE D,ARYF(F) ;GET FLAGS + TLNN D,MRKBIT ;DOES IT HAVE A MARKER? + JRST DF4 ;NOPE, DON'T BOTHER LOOKING + HLRZ B,D + ANDI B,MRKMSK + CAME B,A ;IS THE MARKER THE DELETEE? + JRST DF4 ;NOPE + TLZ D,MRKBIT+MRKMSK ;YES, SO WIPE IT. + HLLM D,ARYF(F) ;AND PUT IT BACK +DF4: HRRE F,D + JUMPGE F,DF3 + + HRRE F,ARYLP ;DELETE ANY LINKS TO THE FLUSHEE + JRST DF2 +DF0: MOVEI D,LPNTR(F) + MOVE B,A + PUSHJ P,REMOVE ;REMOVE B FROM LIST POINTED TO BY D + HRRE F,ARYF(F) ;NEXT ITEM +DF2: JUMPGE F,DF0 + + JRST DOLINK ;DELETE ALL OF THE FLUSHEES INFERIORS + + +;DISPLAY A LINE -- FUNCTION #5 +;DBRITE, DSCALE, AND PENPOS HAVE LOCAL EFFECT ONLY. + +DISALINE: PUSHJ P,ATEST + + PUSHJ P,DLIGHT ;TEMPORARY BRIGHTNESS CHANGE + PUSHJ P,DSIZE ;TEMPORARY SCALE CHANGE + SKIPGE PENPOS + TLO U,PENBIT + SKIPLE PENPOS + TLZ U,PENBIT + + MOVE B,XARG + MOVE C,YARG + MOVE D,ASTATE ;GET STATE OF ARGUMENTS + PUSHJ P,@ARGEVL(D) ;CONVERT ARGUMENTS TO INCREMENTAL + JUMPN B,DSPVCT ;WE MOVED + JUMPN C,DSPVCT + + POPJ P, ;IF NO MOVEMENT, IT'S A NO-OP + +;FUNCTION TO DISPLAY A POINT -- FUNCTION #16. +;DBRITE, DSCALE AND PENPOS HAVE LOCAL EFFECT ONLY + +DPOINT: PUSHJ P,ATEST + + SKIPGE PENPOS + TLO U,PENBIT + SKIPLE PENPOS + TLZ U,PENBIT + +DP1: PUSHJ P,DLIGHT ;TEMPORARY BRIGHTNESS CHANGE + PUSHJ P,DSIZE ;TEMPORARY SCALE CHANGE + + MOVE B,XARG + MOVE C,YARG + MOVE D,ASTATE + PUSHJ P,@ARGEVL(D) ;MODE OF ARGUMENTS +IFN GT40F,PUSHJ P,GADPNT ;SEND STUFF TO GT40 + ADD B,XDISP(A) + ADD C,YDISP(A) + ANDI B,DSPMSK + ANDI C,DSPMSK + PUSHJ P,DSPPNT ;DISPLAY A POINT + + MOVE U,ARYF(A) ;GET UNSULLIED FLAG WORD + TLO U,AWYFLG ;REMEMBER THAT I'M AWAY FROM PEN POSITION + HLLM U,ARYF(A) + POPJ P, + + +;TEST ARRAY NUMBER TO SEE IF IT'S OK + +ATEST: JUMPLE A,ATEST1 ;ARRAY NUMBER MUST BE POSITIVE + CAILE A,MXARS ;AND LESS THAN MXARS +ATEST1: PUSHJ P,NOARY + SKIPG ARYORG(A) + PUSHJ P,NOARY + CAMN A,LNKARY ;IS IT LINK LIST? + PUSHJ P,NOARY ;LINK ARRAY DOESN'T EXIST FOR THE USER! + POPJ P, + +;ARGUMENT CONVERSION FUNCTION FOR DISALINE + +ARGEVL: ARGREL ;RELATIVE TO HOME + ARGABS ;RELATIVE TO SCOPE ORIGIN + POPJP ;INCREMENTAL + APOLAR ;POLAR COORDINATES, X=RADIUS Y=ANGLE IN DEGREES + +ARGREL: MOVE W,ARYORG(A) + HRRZ E,(W) + ANDI E,DSPMSK ;Y HOME POSITION + HLRZ D,1(W) + ANDI D,DSPMSK ;X HOME POSITION + ADD B,D ;NOW IT'S ABSOLUTE + ADD C,E +ARGABS: SUB B,XDISP(A) ;NOW IT'S INCREMENTAL + SUB C,YDISP(A) + POPJ P, + +;POLAR COORDS: XARG=RADIUS YARG=ANGLE IN DEGREES +;ARGS MUST BE FLOATING POINT +APOLAR: JUMPE B,.+3 ;ZERO IS OK + TLNN B,777000 + PUSHJ P,NOTFLT ;NO EXPONENT => BA FLONUM + JUMPE C,.+3 + TLNN C,777000 ;IF NO EXPONENT, IT PROBABLY ISN'T FLONUM + PUSHJ P,NOTFLT + + PUSH P,A ;SAVE ARYNUM + CAMGE C,[360.0] + JRST AP1 + FSBR C,[360.0] + JRST .-3 +AP1: CAMLE C,[-360.0] + JRST AP2 + FADR C,[360.0] + JRST AP1 + +AP2: MOVE A,C ;GET ANGLE + PUSHJ P,SIND + FMPR A,B ;B=FLONUM Y INCREMENT + PUSH P,A + MOVE A,C + PUSHJ P,COSD + FMPR A,B ;A=FLONUM X INCREMENT + POP P,B + ROUND B ;C=FIXNUM Y + ROUND A ;B=FIXNUM X + JRST POPAJ + +COSD: FADR A,[90.0] +SIND: FDV A,[57.295779] ;180.0/PI + JRST .+2 ;SKIPA + FADR A,[1.57079632] ;PI/2 + PUSH P,B + PUSH P,C + MOVE C,A ;SAVE A + MOVMS A + CAMG A,[0.019] + JRST SNSN3 ;SMALL ENOUGH, SO SIN(X)=X + CAML A,[1.0^8 ] + PUSHJ P, INTERR ;TELL HIM I GOOFED + FDV A,[1.57079632] ;PI/2 + CAMG A,[1.0] + JRST SNSN2 ;SMALL ENOUGH NOT TO REQUIRE ARGUMENT REDUCTION + MULI A,400 ;FIX IT + LSH B,-202(A) + MOVEI A,200 + ROT B,3 + LSHC A,33 + FAD A,[0] ;FLOAT IT + JUMPE B,SNSN2 + TLCE B,1000 + FSB A,[1.0] ;01,11 + TLCE B,3000 + TLNN B,3000 + MOVNS A ;01,10 +SNSN2: SKIPGE C + MOVNS A + MOVEM A,C + FMPR A,A + MOVE B,[0.00015148419] ;0 + FMP B,A + FAD B,[-0.00467376557] ;-0.004362476 + FMP B,A + FAD B,[0.07968967928] ;0.079487663 + FMP B,A + FAD B,[-0.64596371106] ;-0.645920978 + FMP A,B + FAD A,[1.57079632] ;PI/2 + FMPR A,C +SINX: POP P,C + POP P,B + POPJ P, + +SNSN3: MOVE A,C + JRST SINX + +;FUNCTION TO ERASE ALL DISPLAY ITEMS -- FUNCTION #6. + +DCLEAR: PUSHJ P,DSTOP ;TURN OFF DISPLAY + SETZM MORFLG +IFE PDP6F,[ SETZM DISLIS +] + + SETOM LNKARY ;RESET LINK ARRAY + SETOM ARYLP ;RESET LOW POINTER + SETOM ARYHP ;RESET HIGH POINTER + HRLOI B, ;0,,-1 + MOVSI A,-MXARS + MOVEM B,ARYF(A) + AOBJN A,.-1 + + SETOM ARYORG ;RESET ARYORG TABLE + MOVE A,[ARYORG,,ARYORG+1] + MOVEI B,MXARS + BLT A,ARYORG-1(B) +IFN GT40F,PUSHJ P,GTCLR ;WIPE OUT GT40 + POPJ P, + +IFE PDP6F,[ +;TEMPORARILY REMOVE AN ITEM FROM THE DISPLAY LIST +;RESTORE BY DOING 'POP P,DISLIS(A)' + +TEMPOF: 0 + MOVE W,DISLIS(A) + PUSH P,W + HRRZ W,DISLIS(A) ;REPLACE POINTER TO BLKO WITH ZERO + JRST @TEMPOF +] +IFN PDP6F,[ +DWAIT: SKIPE DENABL ;DON'T BOTHER IF SCOPE IS OFF + TLNN U,BDISB ;IS THE ITEM DISPLAY ENABLED? + POPJ P, ;NOPE, SO RETURN + PUSH P,E ;SAVE AN AC + SETZM WDFLAG + MOVE E,[JSR FOO1] + MOVEM E,41+2*FLGCH + SKIPN WDFLAG + JRST .-1 + POP P,E + POPJ P, ;OK, AT END OF AN ITEM + +WDFLAG: 0 ;0=>WAITING FOR DISPLAY TO FINISH, -1=>DONE + +FOO1: 0 + SETOM WDFLAG ;LET 'EM KNOW I'M DONE + JRST @FOO1 ;DON'T RELEASE INTERRUPT + +RELEASE: 0 + SKIPE DENABL + TLNN U,BDISB ;IS THE ITEM DISPLAY ENABLED? + JRST @RELEASE ;NOPE, SO RETURN + PUSH P,E + MOVE E,[JSR REDIS] + MOVEM E,41+2*FLGCH + MOVE E,RELEASE + MOVEM E,REDIS + POP P,E + JRST REDIS+1 ;RESTART DISPLAY AND DISMISS INTERUPT +] + + +;FUNTION TO TRANSLATE AN ITEM - LINKABLE -- FUNCTION #7. + +DMOVE%: PUSHJ P,ATEST +IDMOVE: MOVE B,ARYORG(A) + + MOVE D,YARG + ANDI D,DSPMSK + HRRZ W,(B) ;GET Y POSITION + ANDI W,DSPMSK ;GET Y HOME POSITION + SUB D,W + MOVEM D,YINCR ;CHANGE IN Y HOME + ADDM D,YDISP(A) ;CHANGE PEN POSITION TOO + + MOVE D,XARG + ANDI D,DSPMSK + HLRZ W,1(B) + ANDI W,DSPMSK ;X HOME POSITION + SUB D,W + MOVEM D,XINCR ;CHANGE IN X HOME + ADDM D,XDISP(A) ;CHANGE PEN POSITION TOO + +DM1: PUSH P,MODTBL+1 + MOVEI D,MOVPTS + MOVEM D,MODTBL+1 + PUSHJ P,SEARCH ;LOOK FOR ALL POINT MODE WORDS + POP P,MODTBL+1 +IFN GT40F,PUSHJ P,GMOV ;MOVE ITEM IN GT40 + + PUSHJ P,DOLINK ;IF THERE ARE LINKS, DO THEM + JRST DOMARK ;IF THERE IS A MARKER, DO IT TOO + +XINCR: 0 ;X DISPLACEMENT OF SUPERIOR ITEM +YINCR: 0 ;Y DISPLACEMENT OF SUPERIOR + +MOVPTS: ILDB C,BYPNTR ;GET THE WORD + HRRZ D,C + ANDI D,DSPMSK ;GET COORD + TRZ C,DSPMSK ;ERASE OLD POSITION + TRNE C,200000 ;X OR Y? + ADD D,YINCR + TRNN C,200000 + ADD D,XINCR + ANDI D,DSPMSK + ADD C,D ;INSERT NEW POSITION + DPB C,BYPNTR ;LOOK OUT, I'M IN THE DISPLAY ITEM + JRST GETMOD ;DO NEXT WORD + +;GET A DISPLAY ARRAY FROM MASTER -- FUNCTION #8. +; MORFLG=0 => PDP6 CAN'T GET TO BUFFER +; MORFLG=-1 => PDP10 CAN'T GET TO BUFFER + +DGET: SETOM A + MOVE B,WRDCNT ;LENGTH OF SENT ARRAY + PUSHJ P,ARYALS ;MAKE ROOM FOR IT + MOVEM A,ARYNUM ;SAVE ARRAY NUMBER + MOVE C,ARYORG(A) + MOVEM C,DSPLIM(A) ;POINTER INTO ARRAY + +GET1: SKIPN MORFLG ;KEEP OUT OF BUFFER UNLESS MORFLG=-1 + JRST .-1 + CAIG B,BFLNTH ;MORE THAN A BUFFER-FUL? + JRST GET2 ;NOPE + SUBI B,BFLNTH + PUSH P,B + MOVEI B,BFLNTH + PUSHJ P,GOBBLE ;GET THEM INTO THE ARRAY + POP P,B + JRST GET1 ;DO NEXT CHUNK + +;THIS IS THE LAST INSTALLMENT OF DATA FROM THE MASTER +;IT MUST CONTAIN THE 5 WORD TRAILER +GET2: MOVEI W,BUFFER-1 + HRLI W,2200 + ILDB Y,W + CAIE Y,403737 ;WATCH OUT IF THERE ISN'T ANY STOP CODE + JRST .-2 + HRRZS W + AOS W +;FOUND END CODE AND PUT ADDRESS OF NEXT WORD IN W + HRRZ U,(W) ;GET FIRST WORD OF TRAILER + CAIN U,403737 ;IF IT IS A STOP CODE, + JRST DGOLD ;THEN THIS BUFFERFUL IS IN THE OLD FORMAT + MOVE Y,[403737,,403737] + HRLZ U,(W) ;GET FLAGS AND LEAVE THEM IN U ALSO + IORM U,ARYF(A) ;AND SET THEM + MOVEM Y,(W) + MOVE X,1(W) ;GET BYTPNS + ADD X,ARYORG(A) ;AND RELOCATE IT + MOVEM X,BYTPNS(A) + MOVEM Y,1(W) + MOVE X,2(W) ;GET X PEN POSITION + MOVEM X,XDISP(A) + MOVEM Y,2(W) + MOVE X,3(W) ;GET Y PEN POSITION + MOVEM X,YDISP(A) + MOVEM Y,3(W) + MOVE X,4(W) + MOVEM X,BSTORE(A) ;SET PARAMETERS + MOVEM Y,4(W) + PUSHJ P,GOBBLE ;GET IT ALL + MOVN W,ARYL(A) + HRL W,ARYORG(A) + MOVSM W,ARYMPP(A) ;BLKO POINTER + SOS ARYMPP(A) + + MOVE W,ARYL(A) + ADD W,ARYORG(A) + SOS W + MOVEM W,DSPLIM(A) ;END OF ARRAY + + SUBI W,6 ;5 IS FOR THE TRAILER + HRLI W,2200 + MOVEM W,BYTPNT(A) + HLRZ B,1(W) ;GET LEFT HALF OF LAST WORD + CAIE B,403737 ;IS IT STOP CODE + ILDB B,BYTPNT(A) ;IF NOT, INCREMENT BYTE POINTER + + JRST IDISADD + +GOBBLE: MOVE C,DSPLIM(A) + MOVEI D,BUFFER + HRL D,C ;COPY ARRAY (D) INTO ARRAY (C) + MOVSS D + ADD C,B + BLT D,-1(C) + ADDM B,DSPLIM(A) + SETZM MORFLG ;LET PDP10 INTO BUFFER + POPJ P, + +DGOLD: PUSHJ P,GOBBLE + MOVE B,ARYORG(A) + HLRZ W,1(B) + ANDI W,DSPMSK + MOVEM W,XDISP(A) + HRRZ W,(B) + ANDI W,DSPMSK + MOVEM W,YDISP(A) + + PUSHJ P,SEARCH + MOVE W,BYPNTR + SOS W + MOVEM W,BYTPNT(A) ;SET BYTE POINTER + + MOVEI B,347 + MOVEM B,BSTORE(A) ;INITIALIZE BRIGHTNESS AND SCALE + MOVEI W,117 + PUSHJ P,DSPPUT ;SET SCALE IN ITEM + + MOVE W,ARYL(A) + ADD W,ARYORG(A) + SOS W + MOVEM W,DSPLIM(A) + HRLI U,AWYFLG+PENBIT + JRST IDISADD + +;SEND A DISPLAY ARRAY TO MASTER -- FUNCTION #9. +; MORFLG OUGHT TO BE -1 WHEN CALLED +; MORFLG=0 WHEN PDP6 IS DONE WITH THE BUFFER +;EACH SENT ITEM HAS A 5 WORD TRAILER +; WORD 1: FLAGS(BLINKB, PENBIT, AND AWYFLG) +; WORD 2: BYTPNS +; WORD 3: XDISP +; WORD 4: YDISP +; WORD 5: BSTORE + +DSEND: PUSHJ P,ATEST + PUSH P,BYTPNT(A) ;SAVE CURRENT BYTE POINTER + MOVEI W,403737 ;ADD STOP CODE + PUSHJ P,DSPPUT + MOVE X,BYTPNT(A) + TLNE X,220000 ;WAS THAT END OF A WORD? + PUSHJ P,DSPPUT ;NO, ADD ANOTHER ONE + + MOVE Y,ARYORG(A) + HRRZ X,BYTPNT(A) + SUB X,Y + AOS X + MOVEI B,5. + ADD B,X ;TELL USER LENGTH PLUS TRAILER + MOVEM B,WRDCNT + POP P,BYTPNT(A) ;RESTORE OLD BYTE POINTER + +GIV1: SKIPN MORFLG ;KEEP OUT OF BUFFER UNLESS MORFLG=-1 + JRST .-1 + CAIG X,BFLNTH ;MORE THAN A BUFFER-FUL? + JRST GIV2 + SUBI X,BFLNTH + MOVEI B,BFLNTH ;YES, + PUSHJ P,BARF ;SEND THEM TO HIM + SETZM MORFLG ;LET USER INTO BUFFER + JRST GIV1 + +GIV2: MOVE B,X + PUSHJ P,BARF + HLRZ W,ARYF(A) ;GET FLAGS + ANDI W,BLINKB+AWYFLG+PENBIT ;TURN OFF MOST + MOVEM W,BUFFER(X) ;PUT IT INTO BUFFER + MOVE W,BYTPNS(A) + SUB W,ARYORG(A) ;MAKE IT RELATIVE TO START OF ARRAY + MOVEM W,BUFFER+1(X) + MOVE W,XDISP(A) + MOVEM BUFFER+2(X) + MOVE W,YDISP(A) + MOVEM W,BUFFER+3(X) + MOVE W,BSTORE(A) + MOVEM W,BUFFER+4(X) + SETZM MORFLG ;LET USER INTO BUFFER + POPJ P, + +BARF: MOVEI C,BUFFER + MOVE D,C + HRL D,Y ;COPY ARRAY (D) INTO ARRAY (C) OF LENGTH (B) + ADD C,B + BLT D,-1(C) + ADDM B,Y + POPJ P, + + +;FUNCTIONS BLINK AND UNBLINK ARE NOT AVAILABLE IN TIME-SHARING VERSION + + +;FUNCTION TO BLINK AN ITEM - LINKABLE -- FUNCTION #10. + +BLINK: +IFN PDP6F,[ + PUSHJ P,ATEST + TLO U,BLINKB ;ENABLE BLINK + HLLM U,ARYF(A) + JRST DOLINK ;IF THERE ARE LINKS. DO THEM +] +IFE PDP6F+GT40F,POPJ P, ;DON'T DO ANYTHING + +IFN GT40F,[PUSHJ P,ATEST + PUSHJ P,GBLK ;BLINK ITEM IN GT40 + JRST DOLINK +] + +;FUNCTION TO UNBLINK AN ITEM - LINKABLE -- FUNCTION #11. + +UNBLINK: +IFN PDP6F,[ + PUSHJ P,ATEST + TLZ U,BLINKB ;DISABLE BLINK + HLLM U,ARYF(A) + JRST DOLINK ;IF THERE ARE LINKS, DO THEM +] +IFE PDP6F+GT40F,POPJ P, ;;GOODBYE + +IFN GT40F,[PUSHJ P,ATEST + PUSHJ P,GUBL ;UNBLINK ITEM IN GT40 + JRST DOLINK +] + +;CHANGE BRIGHTNESS AND/OR SCALE OF PAST ENTRIES TO A GIVEN ITEM - LINKABLE +; -- FUNCTION #12. +; CURRENT BRIGHTNESS AND SCALE ARE NOT AFFECTED + +DCHANGE: PUSHJ P,ATEST + MOVE B,ARYORG(A) + HLRZ X,(B) ;GET SCALE-BRIGHTNESS WORD OF ITEM + LSH X,-4 + ANDI X,3 ;MASK OUT SCALE BITS + MOVNS X + CAMLE X,DSCALE ;SEE IF SCALE CHANGE IS WITHIN RANGE + JRST .+3 ;NOPE + ADDI X,3 + CAMGE X,DSCALE + MOVEM X,DSCALE + + SKIPN DBRITE + SKIPE DSCALE + SKIPA + POPJ P, ;BOTH SCALE AND BRIGHTNESS DON'T CHANGE + + HLRZ X,1(B) + ANDI X,DSPMSK ;X HOME + HRRZ Y,(B) + ANDI Y,DSPMSK ;Y HOME + MOVE D,[JRST SCLBRT] + MOVEM D,PSWIT + PUSH P,MODTBL+1 ;SAVE OLD POINT MODE + MOVEI D,CPOINT + MOVEM D,MODTBL+1 + PUSHJ P,SEARCH + POP P,MODTBL+1 ;RESTORE POINT MODE + SKIPE DBRITE + DPB D,TBRITE ;STORE TEMP BRIGHTNESS + ROT T,-4 ;GET INTO RIGHT BITS + SKIPE DSCALE + DPB T,TSCALE ;STORE TEMP SCALE + + SKIPE DSCALE + PUSHJ P,MSCALE ;MOVE THE MARKER IF IT EXISTS + + JRST DOLINK ;IF THERE ARE LINKS, DO THEM + + +;T=LAST SCALE SET , D=LAST BRIGHTNESS SET +SCLBRT: SKIPN DBRITE ;EXAMINE THIS HALF WORD + JRST CSCALE + TRNN C,000010 ;IS THE BRIGHTNESS SET HERE? + JRST CSCALE ;NO, EXAMINE SCALE + HRRZ D,C + ANDI D,7 ;GET OLD BRIGHTNESS + ADD D,DBRITE + SKIPG D + SETZM D + CAILE D,7 + MOVEI D,7 + TRZ C,000007 ;REMOVE OLD BRIGHTNESS + ADD C,D + +CSCALE: SKIPN DSCALE + JRST DC1 + TRNN C,000100 + JRST DC1 + HRRZ T,C + ANDI T,60 + ROT T,-4 ;ROTATE WORD + ADD T,DSCALE + SKIPGE T + SETZM T + CAILE T,3 + MOVEI T,3 + ROT T,4 + TRZ C,000060 ;ERASE OLD SCALE + ADD C,T ;INSERT NEW +DC1: + DPB C,BYPNTR ;RESTORE ALTERED HALFWORD + JRST GETMOD ;GET NEXT WORD + +CPOINT: SKIPN D,DSCALE + JRST MSKIP ;NO CHANGE + ILDB C,BYPNTR + HRRZ W,C + ANDI W,DSPMSK + TRNE C,200000 ;X OR Y? + JRST CPY + SUB W,X ;AN X POINT + LSH W,(D) + ADD W,X +CP1: TRZ C,DSPMSK ;REMOVE OLD VALUE + ADD C,W + DPB C,BYPNTR ;RETURN IT + JRST GETMOD + +CPY: SUB W,Y ;A Y POINT + LSH W,(D) + ADD W,Y + JRST CP1 + +;FUNCTION TO SIMULATE 340 PROCESSOR IN ORDER TO FIND CERTAIN MODE WORDS +;B=ADDRESS OF ARRAY TO BE SEARCHED + +SEARCH: +IFE PDP6F,[ + TLNE U,BDISB + JSR TEMPOF ;TAKE ITEM OFF DISPLAY TEMPORARILY +] +IFN PDP6F,[ PUSHJ P,DWAIT +] + SOS B + HRLI B,002200 + MOVEM B,BYPNTR ;EXAMINE HALF WORDS OF DISPLAY ARRAY +;START IN PARAMETER MODE +PMODE: ILDB C,BYPNTR + TRNN C,3000 ;END CODE? +PSWIT: JRST GETMOD ;DO PARAM MODE STUFF +IFE PDP6F,[ + TLNE U,BDISB + POP P,DISLIS(A) ;RESTORE DISPLAY ITEM TO LIST +] +IFN PDP6F,[ JSR RELEASE +] + + POPJ P, + +MSKIP: ILDB C,BYPNTR +GETMOD: LDB D,MODBYT + JRST @MODTBL(D) ;NEXT MODE + +MODBYT: 150300,,C ;HALFWORD IS IN C +MODTBL: PMODE ;000 ; PARAMETER MODE + MSKIP ;001 : POINT MODE SO SKIP IT + . ;NO MODE FOR 010 + CHAR ;011 : CHARACTER MODE + VECT ;100 : VECTOR MODE + MSKIP ;101 : VECTOR CONTINUE SO SKIP IT + VECT ;110 : INCREMENT MODE IS LIKE VECTOR MODE +BYPNTR: 0 + +VECT: ILDB C,BYPNTR + TRNN C,400000 ;END OF VECT MODE? + JRST VECT ;NOPE + JRST PMODE ;YES, GO INTO PARAM MODE + +CHAR: MOVE D,BYPNTR + TLZ D,007700 + TLO D,000600 + + ILDB C,D + CAIE C,37 ;END OF CHAR MODE? + JRST .-2 ;NOPE + + TLZ D,177700 + TLNE D,200000 + TLO D,20000 + TLO D,2200 + MOVEM D,BYPNTR + JRST PMODE ;GO INTO PARAM MODE + +;ROUTINE TO PUT TEXT IN THE DISPLAY LIST -- FUNCTION #13. +; PEN IS ALWAYS DOWN FOR CHARACTERS, BUT IS RESTORED TO ORIGINAL +; CONDITION AFTER DISPLAYING THE TEXT. SIMILARLY, ANY BRIGHTNESS +; OR SCALE CHANGE LASTS ONLY DURING THE DTEXT, AND ORIGINAL VALUES +; ARE RESTORED AT COMPLETION. +; DEFAULT SCALE SIZE IS 1 +; WRDCNT=# OF CHARACTERS TO BE DISPLAYED + + +DTEXT: PUSHJ P,ATEST +IFN GT40F,PUSHJ P,GSTCH ;START SENDING CHARS TO GT40 + + LDB B,DSPMOD ;GET CURRENT MODE + CAIN B,CHRMOD ;IS IT CHARACTER MODE? + JRST DT0 ;YUP + + MOVE B,XARG ;NOPE + MOVE C,YARG + MOVE D,ASTATE + PUSHJ P,@ARGEVL(D) ;MODE OF ARGUMENTS +IFN GT40F,PUSHJ P,GSTCH1 ;TELL GT40 TO MOVE + ADD B,XDISP(A) + ANDI B,DSPMSK + DPB B,XMARG ;SAVE FOR CARRIAGE RETURNS + ADD C,YDISP(A) + ANDI C,DSPMSK + PUSHJ P,DSPPNZ ;MOVE TO START INVISIBLY + + PUSHJ P,DLIGHT ;TEMPORARY BRIGHTNESS CHANGE + MOVEI W,2 ;DEFAULT SCALE IS 2 FOR TEXT + SKIPN DSCALE + MOVEM W,DSCALE + PUSHJ P,DSIZE ;TEMPORARY SCALE CHANGE + + PUSHJ P,MODCHR ;GO INTO CHARACTER MODE + SETZM CASFLG ;START IN UPPER CASE, -1 => LOWER CASE + SETZM CRFLAG ;0=>LAST CHARACTER WASN'T A CR, -1=>IT WAS + +DT0: MOVE B,WRDCNT ;NUMBER OF WORDS IN BUFFER + SKIPN MORFLG + JRST .-1 + CAIG B,MAXCHR + JRST DT1 + SUBI B,MAXCHR + MOVEM B,WRDCNT ;NUMBER FOR NEXT TIME + MOVEI B,MAXCHR + PUSHJ P,BUFGET ;GET A BUFFERFUL OF CHARACTERS + JRST DT0 + +DT1: PUSHJ P,BUFGET ;LAST BUFFERFUL +DT3: TLO U,AWYFLG ;REMEMBER THAT I'M AWAY FROM PEN POSITION + HLLM U,ARYF(A) ;WATCH OUT, RIGHT HALF CHANGES IF ARRAY IS GROWN +IFN GT40F,PUSHJ P,GENDCH ;SEND CHARS TO GT40 + POPJ P, + +BUFGET: MOVEI G,BUFFER ;GET BUFFER ADDRESS + SOS G + HRLI G,700 ;BYTE PNTR +CG1: ILDB W,G ;GET A CHARACTER +IFN GT40F,PUSHJ P,GADCH ;ADD IT TO GT40 LIST + PUSHJ P,CHRTRN ;TRANSLATE TO SCOPE CHARACTERS + SOJG B,CG1 + SETZM MORFLG ;RELEASE BUFFER + POPJ P, ;DONE + +CHRTRN: CAIN W,12 ;IS IT A LINE FEED? + JRST DLF + SKIPE CRFLAG ;WAS A CR NOT FOLLOWED BY A LF? + PUSHJ P,DLF ;YES, SO INSERT ONE + CAIN W,40 ;IS IT A SPACE? + JRST DSPPUT ;YUP + CAIN W,15 ;CR? + JRST DCR + CAIL W,133 + JRST CONV1 ;133 TO 177 + CAIL W,40 + JRST CONV2 ;40 TO 132 + PUSHJ P,LOCASE ;REST MUST BE LOWER CASE + CAIGE W,10 + JRST .+3 + CAIGE W,16 + JRST CONV4 ;10 TO 15 + MOVE C,W + SETZM W ;16 TO 77 DO NOT PRINT + CAIN C,^X + MOVEI W,74 ;HORIZONTAL TEXT MODE + CAIN C,^Y + MOVEI W,76 ;VERTICAL TEXT MODE + JRST DSPPUT + +DCR: SETOM CRFLAG ;REMEMBER THAT I DID A CR + PUSHJ P,MODPNT ;GO INTO POINT MODE + LDB W,XMARG ;X POSITION TO RETURN TO + ANDI W,DSPMSK + PUSHJ P,DSPPUP ;PUT INTO DISPLAY ARRAY + JRST MODCHR ;RETURN TO CHARACTER MODE + +DLF: SETZM CRFLAG ;DOING A LINE FEED TURNS OFF CR FLAG + PUSH P,W + MOVEI W,33 + PUSHJ P,DSPPUT + POP P,W + POPJ P, + +CONV1: PUSHJ P,LOCASE ;GO INTO LOWER CASE + CAIGE W,141 + JRST CONV1A ;133 TO 140 + CAIL W,173 + JRST CONV1B ;173 TO 177 + ANDI W,37 + JRST DSPPUT ;PUT INTO ARRAY + +CONV1A: MOVEI C,-133(W) + MOVE W,[525446516653] +TRANS: IMULI C,6 + ROT W,(C) + JRST DSPPUT + +CONV1B: MOVEI C,-173(W) + MOVE W,[625643570055] + JRST TRANS + +CONV2: SKIPL CASFLG + JRST DSPPUT ;CASFLG=0 =>ALREADY IN UPPER CASE + SETZM CASFLG ;NO IN UPPER CASE + PUSH P,W ;SAVE CURRENT CHAR + MOVEI W,35 + PUSHJ P,DSPPUT + POP P,W + JRST DSPPUT + +CONV4: MOVEI C,-10(W) + MOVE W,[753373773472] + JRST TRANS + +LOCASE: SKIPE CASFLG + POPJ P, ;CASFLG=-1 =>ALREADY IN LOWER CASE + PUSH P,W + MOVEI W,36 + PUSHJ P,DSPPUT ;GO TO LOWER CASE + POP P,W + SETOM CASFLG ;NOW IN LOWER CASE + POPJ P, + +CASFLG: 0 ;0=>UPPER CASE, -1=>LOWER CASE +CRFLAG: 0 ;-1=>LAST CHARACTER WAS A CR + +;FUNCTION TO COPY AN ITEM AND ADD IT TO DISPLAY - LINKABLE -- FUNCTION #14. + +DCOPY: PUSHJ P,ATEST + PUSH P,E + + MOVE E,A + MOVE B,ARYL(E) ;GET LENGTH OF ARRAY TO BE COPIED + SETOM A + PUSHJ P,ARYALS ;MAKE SPACE FOR IT + SETZM LPNTR(A) ;START WITH NO LINKS + MOVE D,ARYORG(E) ;E=INDEX OF OLDY + MOVE C,ARYORG(A) ;A=INDEX OF NEW ITEM + HRL D,C ;COPY ARRAY (B) INTO ARRAY (A) OF LENGTH (C) + MOVSS D + ADD C,ARYL(E) + + BLT D,-1(C) ;MAKE THE MOVE + + EXCH A,E ;A=OLDY, E=NEW + MOVE C,XDISP(A) + MOVEM C,XDISP(E) + MOVE C,YDISP(A) + MOVEM C,YDISP(E) + MOVE C,BSTORE(A) + MOVEM C,BSTORE(E) + MOVE C,ARYF(A) ;GET OLD FLAGS + TLZ C,CRSBIT+MRKBIT+MRKMSK ;TURN OFF MARKER BITS + HLLM C,ARYF(E) ;GIVE NEW ONE SAME FLAG BITS +IFE PDP6F,[ + JUMPGE C,.+4 ;SKIP IT IF DISPLAY BIT ISN'T ON + EXCH A,E + PUSHJ P,DADD ;ADD IT TO DISPLAY + EXCH A,E +] + + MOVE D,ARYORG(E) + SUB D,ARYORG(A) ;RELOCATION AMOUNT + MOVE C,BYTPNT(A) + ADD C,D + MOVEM C,BYTPNT(E) + MOVE C,BYTPNS(A) + SKIPE C + ADD C,D + MOVEM C,BYTPNS(E) + MOVE C,DSPLIM(A) + ADD C,D + MOVEM C,DSPLIM(E) + + SKIPL SUPFLG ;AM I AN INFERIOR ITEM? + PUSHJ P,COPLNK ;YES, LINK TO SUPERIOR + SKIPN LPNTR(A) ;DOES ITEM I AM COPYING HAVE INFERIORS? + JRST DC2 ;NOPE + PUSH P,SUPFLG ;SAVE MY SUPERIOR'S INDEX + MOVEM E,SUPFLG ;NOW I'M THE SUPERIOR + PUSHJ P,DOLINK ;DO ALL MY LINKS + POP P,SUPFLG ;GLORY IS SHORT-LIVED + +DC2: +IFN GT40F,PUSHJ P,GCPY ;COPY ITEM IN GT40 + MOVEM E,ARYNUM ;TELL HIM WHAT INDEX OF NEW ITEM IS + POP P,E + POPJ P, + +SUPFLG: -1 ;-1=>NOT AN INFERIOR + +COPLNK: PUSH P,A + PUSH P,U + MOVE A,SUPFLG ;GET SUPERIOR + MOVE B,E ;GET INDEX # OF INFERIOR + MOVE U,ARYF(A) ;AND HIS FLAGS + PUSHJ P,ILINK ;LINK 'EM + POP P,U ;RESTORE + POP P,A + POPJ P, + +;FUNCTION THAT RETURNS ORIGIN LOCATION AND PEN POSITION +; -- FUNCTION #15. +;PEN UP-DOWN, SCALE AND BRIGHTNESS + +WHERE: PUSHJ P,ATEST + MOVE B,ARYORG(A) + HLRZ D,1(B) ;X HOME + ANDI D,DSPMSK + MOVEM D,BUFFER ;BUFFER+0 = X HOME + HRRZ C,(B) ;Y HOME + ANDI C,DSPMSK + MOVEM C,BUFFER+1 ;BUFFER+1 = Y HOME + MOVE B,XDISP(A) + SUB B,D + MOVEM B,BUFFER+2 ;BUFFER+2 = X PEN POSITION RELATIVE TO HOME + MOVE B,YDISP(A) + SUB B,C + MOVEM B,BUFFER+3 ;BUFFER+3 = Y PEN POSITION RELATIVE TO HOME + LDB B,GBRITE ;GET GLOBAL BRIGHTNESS + AOS B ;CONVERT TO LISP'S SYSTEM + MOVEM B,BUFFER+4 ;BUFFER+4 = CURRENT GLOBAL BRIGHTNESS + LDB B,GSCALE + AOS B + MOVEM B,BUFFER+5 ;BUFFER+5 = CURRENT SCALE + MOVEI C,1 + TLNE U,PENBIT + SETOM C ;BUFFER+6=+1=>PEN UP -1=>PEN DOWN + MOVEM C,BUFFER+6 + HLRZ C,U + ANDI C,MRKMSK ;GET MARKER INDEX NUMBER + MOVEM C,BUFFER+7 ;BUFFER+7 = INDEX OF MARKER ITEM + POPJ P, + +;FUNCTION TO SEIZE OR RELEASE DISPLAY SCOPE +; -- FUNCTION # 17. + +SCOPE: SKIPE DENABL + JRST DSTART ;START UP DISPLAY + PUSHJ P,DSTOP +IFE PDP6F,[ .DCLOSE ;RELEASE DISPLAY +] +IFN PDP6F,[ DATAO PDP,[-1] ;CAUSE PDP6 TO RELEASE ALL DEVICES +] + POPJ P, + +SCPSTE: 0 ;CURRENT STATUS OF SCOPE, 0=>OFF, -1=>ON + + +;SHOW PEN POSITION IN ARRAY SPECIFIED BY ARYNUM -- FUNCTION #18. +;XARG = -1 => USE GENERATED CROSS, IF NOT -1, USE THAT ARRAY + +SHOWPEN: PUSHJ P,ATEST + PUSHJ P,PREM ;REMOVE ANY PREVIOUS MARKER + + SKIPGE B,XARG ;GET INDEX OF MARKER + TLO U,CRSBIT ;IF INDEX=-1, MARKER IS SUPPLIED BY SLAVE + JUMPL B,CROSS ;HE DOESN'T HAVE ONE + ANDI B,DSPMSK +SHOW1: PUSH P,B ;SAVE INDEX OF MARKER + PUSH P,ARYF(B) ;SAVE MARKER'S FLAGS + TLO U,MRKBIT ;SET MARKER BIT + HRLZS B + IOR U,B ;INSERT INDEX OF MARKER ITEM + HLLM U,ARYF(A) ;USE HLLM SINCE RH MAY HAVE CHANGED + PUSHJ P,MRKMOV ;MOVE MARKER TO PEN POSITION + POP P,U + POP P,A + JRST DISADD ;ADD IT TO THE DISPLAY + + +;FUNCTION TO REMOVE A PEN MARKER -- FUNCTION #19. + +HIDEPEN: PUSHJ P,ATEST + +PREM: MOVEI W,DFLUSH + TLZN U,MRKBIT + POPJ P, ;HAS NO MARKER + TLZN U,CRSBIT ;IS THE MARKER HIS? + MOVEI W,DISSUB ;YES, JUST SUBTRACT, DON'T FLUSH + PUSH P,A + PUSH P,U + HLRZ A,U + ANDI A,777 ;GET MARKER ARRAY + MOVE U,ARYF(A) + PUSHJ P,(W) ;REMOVE THE MARKER + POP P,U + POP P,A + TLZ U,MRKMSK ;REMOVE OLD MARKER INDEX + HLLM U,ARYF(A) ;SAVE NEW FLAGS + POPJ P, + +CROSS: PUSH P,A + PUSH P,U + PUSH P,ASTATE + SETZM ASTATE + MOVE W,XDISP(A) + MOVEM W,XARG + MOVE W,YDISP(A) + MOVEM W,YARG + SETOM A + PUSHJ P,CREATE + TLZ U,BDISB ;DON'T DISPLAY IT YET + MOVE G,CROSIZ + MOVEM G,XARG + MOVEM G,PENPOS ;LIFT PEN + SETZM YARG + PUSHJ P,DISALINE + MOVNM G,XARG + SETOM PENPOS + PUSHJ P,DISALINE ;HORIZONTAL BAR + MOVEM G,YARG + SETZM XARG + MOVEM G,PENPOS ;LIFT PEN + PUSHJ P,DISALINE + MOVNM G,YARG + SETOM PENPOS + PUSHJ P,DISALINE ;VERTICAL BAR + + PUSHJ P,BLINK ;BLINK IT + + MOVE B,A ;RETURN INDEX IN B + POP P,ASTATE + POP P,U + POP P,A + JRST SHOW1 + +CROSIZ: 15. + + +MRKMOV: TLNN U,MRKBIT ;MOVE MARKER WITH PEN POSITION + POPJ P, ;NO MARKER + PUSH P,A + PUSH P,U + PUSH P,XARG + PUSH P,YARG + PUSH P,FUNCTION + + LDB T,GSCALE ;GET GLOBAL SCALE + MOVE W,ARYORG(A) + HLRZ X,1(W) + ANDI X,DSPMSK ;X HOME + HRRZ Y,(W) + ANDI Y,DSPMSK ;Y HOME + + JRST MMOV + +MSCALE: TLNN U,MRKBIT ;MOVE MARKER WHEN MARKEE IS SCALED + POPJ P, ;NO MARKER + PUSH P,A + PUSH P,U + PUSH P,XARG + PUSH P,YARG + PUSH P,FUNCTION +MMOV: MOVE W,XDISP(A) + SUB W,X + LSH W,(T) + ADD W,X + MOVEM W,XARG + MOVE W,YDISP(A) + SUB W,Y + LSH W,(T) + ADD W,Y + MOVEM W,YARG + HLRZ A,U + ANDI A,MRKMSK + MOVE U,ARYF(A) + MOVEI W,DMOVE% + MOVEM W,FUNCTION + PUSHJ P,DMOVE% + POP P,FUNCTION ;RESTORE PREVIOUS FUNCTION TYPE + POP P,YARG + POP P,XARG + POP P,U + POP P,A + POPJ P, + +DOMARK: TLNN U,MRKBIT ;IS THERE A MARKER? + POPJ P, ;NOPE + + PUSH P,A + PUSH P,U + HLRZ A,U + ANDI A,777 ;GET NUMBER OF MARKER ARRAY + MOVE U,ARYF(A) + + MOVE B,FUNCTION + MOVE B,FTAB-1(B) + CAIN B,DMOVE% ;IS IT A DMOVE? + MOVEI B,INFMOV + CAIN B,MOTION + MOVEI B,INFMOV + + PUSHJ P,(B) + POP P,U + POP P,A + POPJ P, + +;NEXT TWO PAGES IS CODE TO HANDLE LINKING OF DISPLAY ITEMS + +;FUNCTION TO LINK TOGETHER DISPLAY ITEMS -- FUNCTION #20. +;A=ARRAY NUMBER OF SUPERIOR +;XARG = ARRAY NUMBER OF PROPOSED INFERIOR + +LINK: MOVE B,XARG ;ARRAY NUMBER OF INFERIOR +ILINK: PUSHJ P,ATEST ;TEST EXISTENCE OF SUPERIOR + EXCH A,B + PUSHJ P,ATEST ;DOES INFERIOR EXIST? + EXCH A,B + CAMN A,B ;INFERIOR AND SUPERIOR MUST BE DIFFERENT + POPJ P, + + SKIPGE LNKARY + PUSHJ P,FSBEG ;SET UP FREE STORAGE IF IT HASN'T BEEN YET + + MOVE W,LPNTR(A) ;POINTER TO LIST OF INFERIORS + MOVEI G,LPNTR(A) + JRST LINK2 + +LINK1: MOVE G,W + HLRZ C,(W) + HRRZ W,(W) + CAMN C,B + POPJ P, ;ALREADY LINKED +LINK2: JUMPN W,LINK1 + + SKIPN C,VFREE ;ADD NEW INFERIOR TO LIST + PUSHJ P,FSUSUP + HRL C,(C) + HLRZM C,VFREE + HRRM C,(G) + HRLZM B,(C) + POPJ P, + +;ROUTINE TO REMOVE LINKS -- FUNCTION #21. +;A = ARRAY NUMBER OF SUPERIOR +;XARG = ARRAY NUMBER OF INFERIOR TO BE UNLINKED +;XARG=-1 => ALL LINKS TO SUPERIOR ARE DELETED + +UNLINK: MOVE B,XARG + PUSHJ P,ATEST + JUMPL B,KLINKS ;XARG=-1 => DELETE ALL LINKS TO A + EXCH A,B + PUSHJ P,ATEST ;DOES INFERIOR EXIST + EXCH A,B + + SKIPN C,LPNTR(A) + POPJ P, ;THERE ARE NO INFERIORS TO UNLINK + + MOVEI D,LPNTR(A) + JRST REMOVE + +;REMOVE ENTRY (VALUE IN B) FROM LIST POINTED TO BY D + +REMOVE: SKIPN W,(D) + POPJ P, ;NOTHING ON THE LIST +REM1: HLRZ E,(W) + CAMN E,B + JRST REM2 ;FOUND IT, SO DELETE + MOVE D,W + HRRZ W,(W) + JUMPN W,REM1 + POPJ P, ;END OF LIST WITHOUT FINDING IT + +REM2: MOVE B,(W) + HRRM B,(D) + HRRZ B,VFREE + HRRZM B,(W) + HRRZM W,VFREE + POPJ P, + +;DELETE ALL LINKS TO ARRAY A +KLINKS: MOVE W,LPNTR(A) +KL1: HRRZ D,(W) + HRRZ C,VFREE + HRRZM C,(W) + HRRZM W,VFREE + SKIPE W,D + JRST KL1 + SETZM LPNTR(A) + POPJ P, + +;REPEAT CALLED FUNCTION ON ALL LINKED INFERIORS + +DOLINK: SKIPN C,LPNTR(A) ;ANY LINKS + POPJ P, ;NOPE + + MOVE B,FUNCTION + MOVE B,FTAB-1(B) ;GET FUNCTION ADDRESS + CAIN B,DMOVE% ;IS IT DMOVE? + MOVEI B,INFMOV ;YES, USE SPECIAL MOVE FUNCTION + CAIN B,MOTION ;IS IT MOTION? + MOVEI B,INFMOV ;YUP + MOVEM B,LNFUNC + +IDOLIN: PUSH P,DVAR + MOVEM C,DVAR + PUSH P,A + PUSH P,U + +DOLNK1: SKIPN C,DVAR + JRST DOLNK2 ;END OF LIST + HRL C,(C) + HLRZM C,DVAR + HLRZ A,(C) + MOVE U,ARYF(A) + PUSHJ P,@LNFUNC + JRST DOLNK1 + +DOLNK2: POP P,U + POP P,A + POP P,DVAR + POPJ P, +DVAR: 0 + +INFMOV: PUSHJ P,ATEST + MOVE D,XINCR + ADDM D,XDISP(A) + MOVE D,YINCR + ADDM D,YDISP(A) + MOVE B,ARYORG(A) ;SEARCH NEEDS THIS + JRST DM1 ;DO THE MOVE + +LNFUNC: 0 ;FUNCTION TO APPLY TO LINKS + +FSBEG: PUSH P,A + PUSH P,B + MOVE A,LNKARY + MOVEI B,LNKSIZ + PUSHJ P,ARYALS + MOVEM A,LNKARY + PUSHJ P,FSTINT ;SET UP FREE STORAGE LIST + POP P,B + POP P,A + POPJ P, + +FSTINT: MOVE C,LNKARY + MOVE W,ARYORG(C) + ADD W,ARYL(C) + SUBI W,LNKSIZ + MOVEM W,VFREE + MOVEI B,LNKSIZ + ADD B,W + AOS W +FREPR1: MOVEM W,-1(W) + CAMGE W,B + AOJA W,FREPR1 + SETZM -1(W) + POPJ P, + +FSUSUP: PUSH P,A ;GROW LINK ARRAY + PUSH P,B + MOVE A,LNKARY + MOVE B,ARYL(A) + ADDI B,LNKSIZ + PUSHJ P,ARYALS + PUSHJ P,FSTINT + POP P,B + POP P,A + SOS (P) ;GO BACK AND DO IT OVER + SOS (P) + POPJ P, + +LNKSIZ==100. +LNKARY: -1 + + + +;MOVE ARRAY SPECIFIED BY ARYNUM VIA SPACE WAR CONSOLE SWITCHES +; -- FUNCTION #22. +;WRDCNT =SPEED IN INCHES PER SECOND (APPROX) +;CONSOLE 1 IS IN LEFT HALF, CONSOLE 2 IS IN RIGHT HALF +; LINKABLE + +STPBIT==20000 +LFTBIT==200000 +RGTBIT==400000 +UPBIT==40000 +DWNBIT==100000 + +MOTION: PUSHJ P,ATEST + MOVE V,WRDCNT ;V=TIME BETWEEN SWITCH EXAMS + FMPR V,[113.8] ;CONVERT IN/SEC TO SCOPE-UNITS/SEC (1024/9) + MOVE G,[1.0] + FDVR G,V ;RECIPROCAL OF VELOCITY + FSBR G,[55.4^-6] ;TIME FOR INNER LOOP + SKIPGE G + SETZM G ;HE WANTS TO GO TOO FAST + FDVR G,[1.79^-6] ;TIME FOR ONE SOJGE + FIX G ;T=COUNT FOR SOJGE LOOP + + + MOVE B,ARYORG(A) + HLRZ X,1(B) ;X HOME + ANDI X,DSPMSK + HRRZ Y,(B) + ANDI Y,DSPMSK ;Y HOME + SKIPL XARG ;IF XARG<0, THEN USE SPACE WAR CONSOLE + JRST SLOMOV + + MOVEM X,XARG + MOVEM Y,YARG +MOT1: MOVE X,T ;GET SOJGE COUNT + SOJGE X,. ;WASTE SOME TIME + DATAI 420,W ;READ SWITCHES + SETCM W,W + JUMPE W,.-2 + TLNE W,STPBIT + JRST MOT2 + TLNE W,LFTBIT + SOS XARG + TLNE W,RGTBIT + AOS XARG + TLNE W,UPBIT + AOS YARG + TLNE W,DWNBIT + SOS YARG + PUSHJ P,IDMOVE ;DO THE MOVE + PUSHJ P,ONEFRM ;GO THROUGH DISPLAY LIST ONCE + JRST MOT1 + +MOT2: MOVE W,XARG + ANDI W,DSPMSK ;CLEAN UP X POSITION + MOVEM W,XARG + MOVE W,YARG + ANDI W,DSPMSK ;CLEAN UP Y POSITION + MOVEM W,YARG + POPJ P, + +IFN PDP6F,[ +ONEFRM: SETZM CONTIN + SKIPN CONTIN + JRST .-1 ;WAIT FOR CONTIN TO COME BACK ON + JRST RESTART ;RESTART DISPLAY +] +IFE PDP6F,[ +ONEFRM: MOVEI W,1 + .NDIS W, + PUSHJ P,NO340 + JRST RESTART ;RESTART DISPLAY +] + +SLOMOV: MOVE C,XARG ;X DESTINATION + SUB C,X ;X DIFFERENCE + ADDM C,XDISP(A) ;CHANGE CURRENT PEN POSITION + MOVE D,YARG + SUB D,Y ;Y DIFFERENCE + ADDM D,YDISP(A) + SKIPN C + JUMPE D,POPJP ;DO NOTHING IF NO CHANGE IN POSITION + FLOAT C + FLOAT D + MOVM E,C ;E=MAGNITUDE OF X DIFFERENCE + MOVM F,D ;F=MAGNITUDE OF Y DIFFERENCE + FLOAT X + FLOAT Y + CAMGE F,E + JRST SLOM2 + +;HERE IF Y DIFFERENCE EXCEEDS X DIFFERENCE + MOVEI W,1. + SKIPGE D + MOVNS W + MOVEM W,OINCR + FDVR C,F + MOVEM C,MINCR ;INCREMENT TO X +SLOM1: MOVE C,MINCR + FADRB C,X + ROUND C + ANDI D,DSPMSK + HLRZ E,1(B) + ANDI E,777777-DSPMSK + ADD E,D + + HRRZ F,(B) + ADD F,OINCR + HRRM F,(B) ;SET NEW Y + HRLM E,1(B) ;SET NEW X + + ANDI F,DSPMSK ;GET CURRENT Y VALUE + CAMN F,YARG ;ARE WE THERE YET? + POPJ P, ;YES, RETURN + MOVE F,T + SOJGE F,. ;WASTE SOME TIME + JRST SLOM1 + +;HERE IF X DIFFERENCE EXCEEDS Y DIFFERENCE +SLOM2: MOVEI W,1. + SKIPGE C + MOVNS W + MOVEM W,OINCR + FDVR D,E + MOVEM D,MINCR + +SLOM3: MOVE C,MINCR + FADRB C,Y + ROUND C + ANDI D,DSPMSK + HRRZ E,(B) ;GET OLD + ANDI E,777777-DSPMSK + ADD E,D ;SET NEW Y + + HLRZ F,1(B) ;GET OLD X + ADD F,OINCR + HRLM F,1(B) ;SET NEW X + HRRM E,(B) ;SET NEW Y + + ANDI F,DSPMSK + CAMN F,XARG + POPJ P, + MOVE F,T + SOJGE F,. ;WASTE SOME TIME + JRST SLOM3 + +MINCR: 0 +OINCR: 0 + + +;FUNCTION TO LIST INFERIORS OF SPECIFIED ITEM -- FUNCTION #23. +;XARG=NUMBER OF INFERIORS +;BUFFER CONTAINS INDEX NUMBERS + +LISTINF: PUSHJ P,ATEST + + SETZM W + MOVE D,LPNTR(A) + PUSHJ P,GETINF + MOVEM W,XARG + POPJ P, + +GINF1: HLRZ C,(D) + MOVEM C,BUFFER(W) + AOS W + PUSH P,D + MOVE D,LPNTR(C) + PUSHJ P,GETINF + POP P,D + HRRZ D,(D) +GETINF: SKIPE D + JRST GINF1 + POPJ P, + + +;FUNCTION TO LIST ALL ITEMS CURRENTLY ON DISPLAY -- FUNCTION #24. +;XARG=NUMBER +;BUFFER CONTAINS INDEX NUMBERS + +DLIST: HRRE F,ARYLP + SETZM W + JRST DL2 + +DL1: MOVE A,ARYF(F) + TLNN A,BDISB + JRST .+3 + MOVEM F,BUFFER(W) ;PUT IN BUFFER + AOS W ;AND KEEP COUNT + HRRE F,A ;NEXT +DL2: JUMPGE F,DL1 + + MOVEM W,XARG + POPJ P, + +;FUNCTION TO SET GLOBAL PEN POSITION, GLOBAL BRIGHTNESS AND SCALE +; -- FUNCTION #25. +;ARYNUM IS THE ITEM AFFECTED +;PENPOS, DBRITE, AND DSCALE ARE THE RELEVANT PARAMETERS + +DSET: PUSHJ P,ATEST + + SKIPGE PENPOS + TLO U,PENBIT ;PENPOS=-1 => PUT PEN DOWN + SKIPLE PENPOS + TLZ U,PENBIT ;PENPOS=+1 => LIFT UP PEN + HLLM U,ARYF(A) + + PUSHJ P,DSIZE + PUSHJ P,DLIGHT + LDB W,[050501,,BSTORE] ;GET TEMPORARY SCALE AND BRIGHTNESS + DPB W,[000501,,BSTORE] ;AND MAKE THEM GLOBAL + + POPJ P, + + +;FUNCTION TO EXPOSE N FRAMES ON THE MOVIE CAMERA +; -- FUNCTION #26. + +FRAME: PUSHJ P,DSTOP + SKIPN C,WRDCNT ;NON-ZEO NUMBER OF FRAMES? + POPJ P, ;NOPE, SO RETURN + +IFE PDP6F,[ + SKIPE DENABL + JRST FRM4 ;SCOPE ISN'T OFF + PUSH P,DISLIS + SETZM DISLIS + .DSTART DISLIS + PUSHJ P,NO340 + POP P,DISLIS + PUSHJ P,DSTOP +] +FRM4: PUSH P,DENABL ;SAVE SCOPE STATE + SETOM DENABL ;ALWAYS ON FOR FRAME COMMAND + +;NUMBER OF FRAMES IS IN C +IFN PDP6F,[ +FRM2: CONI DIS,W ;MAKE SURE PDP6 HAS SCOPE + TLNN W,400000 + JRST NO340 ;SEND ERROR MESSAGE IF SCOPE UNAVAILABLE + + MOVEI D,2. ;# OF EXPOSURES PER FRAME + PUSHJ P,SOPEN ;OPEN THE SHUTTER +FRM1: SETZM CONTIN ;DISPLAY IN ONESHOT MODE +;DANGER! IF SCOPE BECOMES UNAVAILABLE HERE, SHUTTER GETS 180 +; DEGREES OUT OF PHASE + PUSHJ P,RESTART ;RESTART THE DISPLAY + SKIPN CONTIN ;WAIT FOR CONTIN TO COME BACK ON + JRST .-1 + SOJG D,FRM1 ;DISPLAY IT AGAIN + PUSHJ P,SCLOSE ;CLOSE THE SHUTTER + SOJG C,FRM2 ;EXPOSE ANOTHER FRAME +] +IFE PDP6F,[ + .NDIS C, + PUSHJ P,NO340 +] + POP P,DENABL ;RESTORE SCOPE STATE + JRST RESTART ;RESTART THE DISPLAY + +IFN PDP6F,[ +SCLOSE: SKIPN SHUTTR + POPJ P, ;SHUTTER IS ALREADY CLOSED + SETZM SHUTTR + JRST SOPEN1 + +SOPEN: SKIPE SHUTTR + POPJ P, + SETOM SHUTTR +SOPEN1: MOVEI X,62 +SOPEN2: MOVEI Y,100 + XORB Y,MOTOR + DATAO 760,Y + MOVEI Y,550 + SOJG Y,. + MOVEI Y,200 + XORB Y,MOTOR + DATAO 760,Y + MOVEI Y,550 + SOJG Y,. + SOJG X,SOPEN2 + POPJ P, + +SHUTTR: 0 ;0=>SHUTTER IS OPEN, -1=>SHUTTER IS CLOSED +MOTOR: 0 ;LAST WORD OUTPUTTED TO MOTOR + +] +;START AND STOP DISPLAY + +DSTART: SKIPE SCPSTE + POPJ P, +RESTART: SKIPN DENABL ;IS IT ON? + POPJ P, ;ALREADY ON, OR NOT ENABLED +IFE PDP6F,[ + .DSTOP ;STOP IT +IFN GT40F,[ + SKIPE GTTY + JRST .+3 ;DON'T TRY TO USE 340 +] .DSTART DISLIS ;AND RESTART IT + JRST NO340 ;340 NOT AVAILABLE + SETOM SCPSTE ;SHOW THAT SCOPE IS ON + POPJ P, +] +IFN PDP6F,[ + CONO DIS,100 ;TURN IT OFF + CONI DIS,W + TLNN W,400000 + JRST NO340 ;PDP10 HAS 340 + + SKIPA W,ARYLP ;CHECK TO MAKE SURE SOMETHING IS ON LIST +DST3: HRRE W,B + JUMPL W,DSTOP + MOVE B,ARYF(W) + JUMPGE B,DST3 + HRREM B,DPNTR ;AHA! FOUND ONE + MOVE B,ARYMPP(W) + MOVEM B,BLKOP + MOVE W,[BLKO DIS,BLKOP] +DST4: MOVEM W,40+2*DISCH + SETOM SCPSTE ;SHOW THAT SCOPE IS ON + CONO DIS,100+FLGCH_3+DISCH + POPJ P, + +] + +DSTOP: +IFN PDP6F,[ + CONO DIS,100 ;STOP DISPLAY + SETOM CONTIN ;POP OUT OF ONESHOT MODE +] +IFE PDP6F,[ .DSTOP ;STOP DISPLAY +] + SETZM SCPSTE ;SHOW THAT SCOPE IS OFF + POPJ P, + +;GOODIES STORED FOR EACH DISPLAY ITEM + +DSPMSK==1777 ;MASK FOR DISPLAY COORDINATES +MXARS==100. ;FIXED MAX NUMBER OF ARRAYS +;THERE ARE 15 RESERVED WORDS FOR EACH DISPLAY ITEM + +IFE PDP6F,[ +DISLIS: REPEAT MXARS,0 ;LIST OF DISPLAY ITEMS + 0 +] + +ARYORG: REPEAT MXARS,-1 ;-1 OR CURRENT ARRAY ORGIN +ARYL: BLOCK MXARS ;CURRENT LENGTH +ARYF: REPEAT MXARS, ,-1 ;LH=FLAG BITS + ;RH = ARY # OF NEXT HIGHER ARRAY, -1 IF NONE +ARYMPP: BLOCK MXARS ;BLKO PTR FOR DIS + +;FLAG BITS IN LEFT HALF OF ARYF WORDS ARE: +BDISB==400000 ;STOP DISPLAY BIT +BLINKB==200000 ;1=>THIS ARRAY IS BLINKING, 0=> NO BLINK +AWYFLG==100000 ;1=>DISPLAY IS AWAY FROM PEN POSITION +PENBIT==40000 ;0=>PEN IS UP, 1=>PEN IS DOWN +CRSBIT==20000 ;1=>MARKER ITEM IS SYSTEM'S 0=>SUPPLIED BY USER +MRKBIT==1000 ;0=>NO MARKER ARRAY 1=>LOOK FOR ARRAY NUMBER +MRKMSK==777 ;THESE BITS CONTAIN NUMBER OF MARKER ARRAY + +ARYHP: ,-1 ;PNTR TO HIGHEST ARRAY +ARYLP: -1 ;PNTR TO LOWEST ARRAY + +BYTPNT: BLOCK MXARS ;PNTR INTO DISPLAY BUFFER +BYTPNS: BLOCK MXARS ;PNTR TO DISPLAY BUFF WHERE ENTERED INCR OR VECTOR MODE +DSPLIM: BLOCK MXARS ;END OF BUFFER +LPNTR: BLOCK MXARS ;POINTER TO LISTS OF INFERIORS +VFREE: 0 ;FREE STORAGE LIST HEAD + +YDISP: BLOCK MXARS ;CURRENT Y COORD +XDISP: BLOCK MXARS ;CURRENT X COORD +BSTORE: BLOCK MXARS ;STORAGE WORD FOR MISCELLANEOUS BITS +;ALL OF THE FOLLOWING REQUIRE ITEM INDEX TO BE IN A +GBRITE: 000300,,BSTORE(A) ;BITS 4.7-4.9 ARE GLOBAL BRIGHTNESS +GSCALE: 030200,,BSTORE(A) ;BITS 4.5-4.6 ARE GLOBAL SCALE +TBRITE: 050300,,BSTORE(A) ;BITS 4.2-4.4 ARE TEMPORARY BRIGHTNESS +TSCALE: 100200,,BSTORE(A) ;BITS 3.9-4.1 ARE TEMPORARY SCALE +XMARG: 121200,,BSTORE(A) ;BITS 2.8-3.8 ARE X MARGIN FOR CARRAIGE RETURN +DSPMOD: 240300,,BSTORE(A) ;BITS 2.5-2.7 ARE CURRENT MODE OF ITEM + +;MODE OF DISPLAY +PARMOD==0 ;PARAMETER MODE +PNTMOD==1 ;POINT MODE +CHRMOD==3 ;CHARACTER MODE +VECMOD==4 ;VECTOR MODE +VCCMOD==5 ;VECTOR CONTINUE MODE (NOT USED IN SLAVE) +INCMOD==6 ;INCREMENT MODE (NOT USED IN SLAVE) + +;ROUTINES FOR HANDLING ARRAYS + +ARYDEL: JUMPL A,CPOPJ + MOVEI B,0 ;DELETE ARRY IN A +ARYALS: MOVEM 16,ARYAC+16 ;OR GENERATE A NEW ONE + MOVE 16,[C,,ARYAC+C] + BLT 16,ARYAC+15 + PUSHJ P,ARYAL + MOVS 16,[C,,ARYAC+C] + BLT 16,16 + POPJ P, + +ARYAC: BLOCK 17 ;SAVED ACS WHILE ARRAYING + +;A=-1 => GENERATE NEW ARRAY, ELSE RE-ALLOCATE OLD ONE +;B=LENGTH +ARYAL: JUMPGE A,ARYA1 ;LOOK FOR AN EMPTY TABLE SLOT + MOVE F,[-MXARS,,1] ;ARRAY ZERO IS NOT ALLOWED + SKIPGE ARYORG(F) + JRST ARYAL2 + AOBJN F,.-2 + PUSHJ P,ARRFUL ;TOO MANY ARRAYS + +;HERE TO CREATE A NEW ARRAY +ARYAL2: HLLM B,ARYF(F) ;STORE FLAGS + HRRZS B ;B=LENGTH OF NEW ARRAY + MOVEI D,FS ;LOOK FOR HOLE + HRRE C,ARYLP ;INDEX OF LOWEST ARRAY SO FAR + MOVEI W,ARYLP + JUMPL C,ARYAL8 ;NO ACTIVE ARRAYS +ARYAL5: MOVN X,D + ADD X,ARYORG(C) + CAIL X,(B) + JRST ARYAL4 ;FOUND BIG ENUF HOLE + MOVE D,ARYORG(C) + ADD D,ARYL(C) + MOVEI W,ARYF(C) + HRRE C,ARYF(C) ;GET INDEX OF NEXT ARRAY + JUMPGE C,ARYAL5 + +ARYAL3: HRRZ C,FSP ;NO HOLE ADD ARRAY TO TOP + ADDI C,(B) + PUSHJ P,MEMGT ;DO I HAVE ENOUGH ROOM? + PUSHJ P,MEMFUL ;NO + HRRZ A,F ;YUP. A=INDEX OF NEW ARRAY + HRRE F,ARYHP ;INDEX OF USED TO BE HIGHEST + MOVEM A,ARYHP ;NOW HIGHEST + JUMPL F,ARYAL6 ;FIRST ARRAY + HRRM A,ARYF(F) ;PATCH PREVIOUS HIGHEST TO POINT TO ME + +ARYAL7: MOVE C,FSP +ARYSX2: MOVEI X,0 +ARYSX: MOVEM C,ARYORG(A) ;STORE BEGINNING OF THIS ARRAY + MOVEI F,-1(C) + HRRM F,ARYMPP(A) ;ADDRESS OF DISPLAY BLKO + ADD X,C ;CLEAR ALL BUT FIRST X REG + ADDI C,(B) ;LENGTH IN B + CAMLE C,FSP + MOVEM C,FSP + CAML X,C + JRST ARYSX1 + MOVE F,[403737,,403737] ;FILL WITH STOP CODES + MOVEM F,(X) + HRLS X + AOS X + CAILE C,(X) + BLT X,-1(C) +ARYSX1: HRRZM B,ARYL(A) ;SET LENGTH OF THIS ARRAY + MOVN X,ARYL(A) + HRLM X,ARYMPP(A) ;LENGTH FOR BLKO + POPJ P, + +ARYAL8: MOVEI C,FS ;HERE IF NO ACTIVE ARRAYS + MOVEM C,FSP + JRST ARYAL3 + +ARYAL6: MOVEM A,ARYLP ;HERE IF FIRST ARRAY + JRST ARYAL7 + +ARYAL4: HRRZ A,F ;HERE TO DROP NEW ARRAY INTO A HOLE + HRRZ C,(W) ;PICK UP PNTR THAT PNTED TO FROB WE ARE INSERTING IN FRONT OF + HRRM C,ARYF(A) + HRRM A,(W) ;MAKE HIM POINT AT ME + MOVE C,D + JRST ARYSX2 + + +;C=DESIRED END OF ARRAY +MEMGT: +IFE PDP6F,[ + CAML C,CORTOP + JRST .+3 + AOS (P) + POPJ P, ;SKIP IF ENOUGH CORE IS AVAILABLE + MOVE D,CRSZ +NOCRER: CAMGE D,CRLM + JRST AOCRSE + .CORE 1(D) + POPJ P, ;NO CORE AVAILABLE + AOS CRLM +AOCRSE: AOS CRSZ + MOVEI D,2000 + ADDM D,CORTOP + JRST MEMGT +] +IFN PDP6F,[ + CAIGE C,MEMSIZ + AOS (P) + POPJ P, +] + + +ARYA1: SKIPGE ARYORG(A) ;HERE TO REALLOCATE AN OLDY + JRST ARYA1L ;THIS ARRAY NUMBER DOESN'T EXIST + HRRZS B + CAMN B,ARYL(A) + POPJ P, ;CORRECT SIZE ALREADY + CAML B,ARYL(A) + JRST ARYEX ;EXPANDING EXISTING ARRAY + EXCH B,ARYL(A) ;SHRINK THIS ARRAY + SUB B,ARYL(A) ;COMPUTE # REG VACATED + MOVN F,ARYL(A) + HRLM F,ARYMPP(A);STORE NEW LENGTH IN DIS PNTR + SKIPN F + SETZM ARYMPP(A) + SKIPN ARYL(A) + JRST ARYA6E ;FLUSHING ARRAY +ARY8A: HRRE F,ARYHP + JUMPL F,CPOPJ + HRRZ B,ARYORG(F) + ADD B,ARYL(F) + MOVEM B,FSP + POPJ P, + +ARYA1L: MOVNI A,1 ;ARRAY DIDN'T EXIST, SO MAKE ONE + JRST ARYAL + +;HERE TO FLUSH AN ARRAY +ARYA6E: MOVEI W,ARYLP-ARYF + HRRZ F,ARYLP +ARYA6A: CAMN F,A + JRST ARYA6B ;FOUND WHAT PNTS TO ME + MOVE W,F + HRRE F,ARYF(F) + JUMPGE F,ARYA6A +IFN PDP6F,[ JRST 4,. ;ARRAY LIST FOULED UP +] +IFE PDP6F,[ + .VALUE 0 ;ARRAY LIST FOULED UP - BUG ! +] + +ARYA6B: SETOM ARYORG(A) ;W IS ARRAY THAT POINTED AT FLUSHEE + HRRZ D,ARYF(A) + HRRM D,ARYF(W) ;MAKE HIM PNT TO WHAT I POINTED TO + HRLOI D,0 + MOVEM D,ARYF(A) ;RESET FLAGS AND POINTER + CAIN W,ARYLP-ARYF + MOVEI W,-1 ;IF I AM HIGHEST ARRAY I AM LAST ONE + CAMN A,ARYHP + HRRM W,ARYHP ;I WAS HIGHEST ARY SO HE IS NOW + JRST ARY8A + + +;HERE TO EXPAND AN EXISTING ARRAY + ;A=ARRAY INDEX, B=DESIRED NEW SIZE +ARYEX: CAMN A,ARYHP + JRST ARYEX3 ;TOP MOST ARRAY + HRRZ F,ARYF(A) ;COMPUTE BEG OF NEXT ARRAY + MOVE C,ARYORG(F) + SUB C,B + CAMG C,ARYORG(A) + JRST ARYSHF ;SHUFFLE NECCESSARY + ;DROP THRU ON CAN EXPAND INTO HOLE +ARYEX4: MOVE X,ARYL(A) ;DONT CLEAR OLD PART OF ARRAY + MOVE C,ARYORG(A) + JRST ARYSX + +ARYEX3: MOVE C,B ;EXPAND TOP MOST ARRAY + ADD C,ARYORG(A) + PUSHJ P,MEMGT ;HAVE ROOM? + PUSHJ P,MEMFUL ;NO + JRST ARYEX4 + +ARYSHF: HRRZ X,ARYHP ;GET INDEX OF HIGHEST + MOVE C,ARYORG(X) + ADD C,ARYL(X) + ADD C,B ;WHERE A WILL END IF MOVED AND EXPANDED + PUSHJ P,MEMGT ;HAVE ROOM? + JRST ARYSH1 ;NOT YET +;LOTS OF ROOM + MOVEI F,ARYLP-ARYF ;START WITH OLDEST ITEM +ARYSF0: HRRE W,F ;FIND OUT WHO POINTS TO EXPANDEE + HRRZ F,ARYF(W) + CAME A,F + JRST ARYSF0 +;W POINTS TO EXPANDEE + HRRZ F,ARYF(A) ;WHERE EXPANDEE POINTS + HRRM F,ARYF(W) ;W POINTS PAST EXPANDEE + HRRZ F,ARYF(X) ;GET -1 FROM HIGHEST + HRRM F,ARYF(A) ;EXPANDEE POINTS TO -1 + HRRM A,ARYF(X) ;PREVIOUS HIGHEST NOW POINTS TO EXPANDEE + HRRZM A,ARYHP ;EXPANDEE IS HIGHEST + PUSH P,A + PUSH P,B + SUB C,B ;WHERE IT SHOULD START + MOVE F,A + PUSHJ P,ARYMVU ;MOVE UP ARRAY F TO C + POP P,B + POP P,A + JRST ARYAL ;NOW REALLOCATE IT + +;GETS HERE ONLY IF SPACE IS REALLY TIGHT +ARYSH1: SUB C,ARYL(A) ;WILL OLD SPACE HELP? + PUSHJ P,MEMGT + PUSHJ P,MEMFUL ;JUST WON'T FIT + HRRM A,ARYF(X) + HRRM A,ARYHP ;A IS NOW HIGHEST + PUSH P,A + PUSH P,B + ADD C,ARYL(A) + SUB C,B ;WHERE IT SHOULD START + MOVE F,A + PUSHJ P,ARYMVU ;MOVE ON UP + POP P,B + POP P,A + JRST ARYAL ;OK, REALLOCATE + ;MOVE AN ARRY DOWN +;C=WHERE ARRAY SHOULD START, F=INDEX OF THE ARRAY +;THIS ROUTINE IS CALLED BY MAIN PROGRAM + +ARYMVD: CAML C,ARYORG(F) +IFE PDP6F,[ .VALUE 0 ;BUG ! +] +IFN PDP6F,[ JRST 4,. ;BUG +] + SKIPG ARYF(F) + PUSHJ P,DSTOP + HRRZ D,C + HRL D,ARYORG(F) + MOVE X,D + ADD X,ARYL(F) + BLT D,-1(X) ;MOVE IT +ARYRST: PUSHJ P,ARYRL ;RELOCATE RELEVANT WORDS OF ITEM DATA + HRRZM C,ARYORG(F) + CAMN F,LNKARY ;WAS IT LINK ARRAY I JUST MOVED? + PUSHJ P,FREREL ;YES, I MUST ADJUST LIST POINTERS + SKIPG ARYF(F) ;IS IT ON DISPLAY LIST? + JRST DSTART + POPJ P, + +FREREL: MOVN B,ARYL(F) ;GET LENGTH OF LINK ARRAY + HRLZS B + HRR B,ARYORG(F) + HRRZ X,(B) + SKIPE X + ADDM W,(B) ;W CONTAINS POSITION CHANGE (FROM ARYRL) + AOBJN B,.-3 + + HRRE B,ARYLP + SKIPE LPNTR(B) + ADDM W,LPNTR(B) ;INCREMENT OLD POINTER + HRRE B,ARYF(B) ;GET NEXT ITEM + JUMPGE B,.-3 + + POPJ P, + +;MOVE AN ARRAY UP +;C=DESIRED ORIGIN, F=INDEX TO ARRAY +ARYMVU: SKIPG ARYF(F) + PUSHJ P,DSTOP + MOVE D,C ;NEW ADDRESS + MOVE X,ARYORG(F) ;OLD ADDRESS + ADD D,ARYL(F) ;LAST NEW ADR+1 + ADD X,ARYL(F) ;LAST OLD ADR+1 +ARYMV1: MOVE W,-1(X) + MOVEM W,-1(D) + SOS X + CAML X,ARYORG(F) + SOJA D,ARYMV1 + JRST ARYRST + +;RELOCATE WORDS ASSOCIATED WITH ITEM IN 'F' +ARYRL: HRRZ D,ARYORG(F) ;OLD LOWER RANGE + MOVE X,D + ADD X,ARYL(F) ;OLD UPPER LIMIT + MOVE W,C + SUB W,ARYORG(F) ;CHANGE + HRRZ U,ARYMPP(F) + ADD U,W + HRRM U,ARYMPP(F) ;RELOCATE BLKO POINTER + HRRZ U,BYTPNT(F) + ADD U,W + HRRM U,BYTPNT(F) ;RELOCATE BYTE POINTER + HRRZ U,DSPLIM(F) + ADD U,W + HRRM U,DSPLIM(F) ;RELOCATE END OF ITEM + SKIPE U,BYTPNS(F) + ADD U,W + HRRM U,BYTPNS(F) ;RELOCATE START OF MODE + HRRZ U,VFREE + CAMN F,LNKARY ;DID I MOVE THE LINK ARRAY? + ADD U,W ;YES, SO RELOCATE IT + HRRM U,VFREE + POPJ P, + +;ROUTINE TO DISPLAY POINTS +;FLAG BITS ARE IN U + +DSPPNT: TLNN U,PENBIT +DSPPNZ: TDZA D,D ;NO INTENSIFY +DSPPNI: MOVEI D,2000 ;INTENSIFY + PUSHJ P,MODPNT ; MAKE SURE THE DISPLAY IS IN POINT MODE +DSPPTU: LDB T,GSCALE ;GET GLOBAL SCALE + SKIPN T ;AM I SCALED? + JRST DSPINA ;NOPE + + MOVE W,ARYORG(A) + HLRZ X,1(W) + ANDI X,DSPMSK ;X HOME + HRRZ Y,(W) + ANDI Y,DSPMSK ;Y HOME + SUB B,X + SUB C,Y + LSH B,(T) ;SCALE IT + LSH C,(T) + ADD B,X + ADD C,Y + ANDI B,DSPMSK + ANDI C,DSPMSK + + +DSPINA: +IFE PDP6F,[ + TLNE U,BDISB + JSR TEMPOF ;TURN OFF TEMPORARILY +] + LDB X,BYTPNT(A) ;GET LAST HALF WORD + IORI X,20000 ;PUT IN POINT MODE BITS +IFN PDP6F,[ PUSHJ P,DWAIT +] + DPB X,BYTPNT(A) +IFN PDP6F,[ JSR RELEASE +] + MOVE W,C + IORI W,200000 ; BIT USED TO INDICATE Y VALUE + PUSHJ P,DSPPUP + MOVE W,B + IORI W,(D) ; MERGE IN INTENSIFY BIT IF IT EXISTS + PUSHJ P,DSPPUT ; PUT VALUE IN BUFFER +IFE PDP6F,[ TLNE U,BDISB + POP P,DISLIS(A) +] + POPJ P, + +; ROUTINE TO HANDLE THE PLACING OF VECTORS INTO THE DISPLAY LIST +;A=ARRAY NUMBER, B=X INCREMENT, C=Y INCREMENT +;FLAG BITS ARE IN U +;ALWAYS INCREMENTAL!!! + +DSPVCT: +IFN GT40F,PUSHJ P,GADLIN ;SEND STUFF TO GT40 + TLNE U,AWYFLG ;AM I AT PEN POSITION? + PUSHJ P,GETBCK ;NOPE + ADDM B,XDISP(A) + ADDM C,YDISP(A) +IFE PDP6F,[ TLNE U,BDISB + JSR TEMPOF ;TURN OFF TEMPORARILY +] + PUSHJ P,DSPVEC +IFE PDP6F,[ TLNE U,BDISB + POP P,DISLIS(A) +] + JRST MRKMOV ;MOVE THE MARKER IF IT EXISTS + +DSPVEC: PUSHJ P,MODVEC ;PUT DISPLAY IN VECTOR MODE + TLNN U,PENBIT + TDZA D,D +DSPLNE: MOVEI D,200000 ;INTENSIFY +DSPLIN: LDB F,[430100,,B] ;CLOBBERS B,C,D,E,F,W,X + LDB W,[430100,,C] + DPB W,[10100,,F] ;SAVE SIGN BITS + MOVMS B + MOVMS C + CAIGE B,4000 + CAIL C,4000 + JRST VPLOT4 +VPLOT3: SKIPN B ;SEE IF ZERO LENGTH VECTOR + JUMPE C,POPJP + CAIGE B,200 + CAIL C,200 + JRST VPLOT1 +VPLOT2: MOVEI W,@VECTBL(F) + DPB C,[80700,,W] + IOR W,D ;INTENSIFY BIT + JRST DSPPUT + +VPLOT4: PUSHJ P,BIGVEC ;VECTOR IS ENORMOUS +VPLOT1: PUSH P,B + PUSH P,C + CAMLE B,C + TLOA F,400000 + EXCH B,C + IMULI C,177 + IDIVM C,B + MOVEI C,177 + TLZE F,400000 + EXCH B,C + PUSHJ P,VPLOT2 + POP P,W + SUBM W,C + POP P,W + SUBM W,B + JRST VPLOT3 + +VECTBL: 000000(B) + 000200(B) + 100000(B) + 100200(B) + +GETBCK: PUSH P,B + PUSH P,C + LDB B,DSPMOD ;GET CURRENT MODE + CAIE B,PNTMOD ;IS IT POINT MODE? + JRST GETB2 ;NOPE + LDB B,BYTPNT(A) ;GET CURRENT BYTE + ANDI B,DSPMSK + CAME B,XDISP(A) ;IS IT AT CURRENT X? + JRST GETB2 ;NOPE + MOVE C,BYTPNT(A) + TLNE C,200000 + SOS C + TLC C,220000 + LDB B,C ;GET PREVIOUS BYTE + ANDI B,DSPMSK + CAMN B,YDISP(A) ;IS IT AT CURRENT Y? + JRST GETB3 ;YES, SO DON'T NEED ANOTHER POINT + +GETB2: MOVE B,XDISP(A) + MOVE C,YDISP(A) + PUSHJ P,DSPPNZ ;MOVE TO PEN POSITION INVISIBLY +GETB3: MOVE C,ARYF(A) ;GET FLAGS + TLZ C,AWYFLG ;TURN OFF AWAY FLAG + HLLM C,ARYF(A) + POP P,C + POP P,B + POPJ P, + +;ROUTINES TO HANDLE SCALE CHANGES +;W=NEW SCALE (1-4) + +DSIZE: SKIPE W,DSCALE ;DSCALE=0 => NO CHANGE + SOSA W ;SUBTRACT ONE TO CONVERT TO 340 VALUE + LDB W,GSCALE ;GET GLOBAL SCALE + LDB X,TSCALE ;GET TEMPORARY SCALE + CAMN W,X + POPJ P, ;IF SAME, EVERYTHING IS OK +DSIZ2: ANDI W,3 + DPB W,TSCALE ;REMEBER LAST SCALE SETTING + LSH W,4 + IORI W,100 ;ADD ENABLE BIT + PUSHJ P,MODPRM + LDB X,BYTPNT(A) + ANDCMI X,60 + JRST DSPBTH ; GO FINISH UP + +;ROUTINES TO HANDLE INTENSITY CHANGES +;W=INTENSITY (1-8) + +DLIGHT: SKIPE W,DBRITE ;DBRITE=0 => NO CHANGE + SOSA W ;SUBTRACT ONE TO CONVERT TO 340 VALUE + LDB W,GBRITE ;GET GLOBAL BRIGHTNESS + LDB X,TBRITE ;GET TEMPORARY BRIGHTNESS + CAMN W,X + POPJ P, ;YES +DSPBRT: ANDI W,7 + DPB W,TBRITE ;REMEMBER LAST BRIGHTNESS SETTING + IORI W,10 ;ADD ENABLE BIT + PUSHJ P,MODPRM ; PUT DISPLAY IN PARAMETER MODE + LDB X,BYTPNT(A) + ANDCMI X,7 +DSPBTH: IOR W,X + DPB W,BYTPNT(A) ;CLOBBER ON TOP OF SKEL + POPJ P, + +;ADD MODE BITS TO HALF-WORD IN 'W' AND INSERT INTO ITEM +DSPPUP: LDB X,DSPMOD ;GET THE CURRENT MODE + LSH X,15 ;SHIFT BITS INTO PROPER POSITION + IOR W,X ;MERGE INTO WORD +;INSERT HALF-WORD IN 'W' INTO ITEM +DSPPUT: HRRZ X,BYTPNT(A) ; GET CURRENT VALUE OF ARRAY POINTER + CAML X,DSPLIM(A) ; CHECK TO SEE IF THE ARRAY IS FULL + JRST DSPFUL ; FULL - BETTER CHECK STATUS +DSPPTZ: +IFN PDP6F,[ PUSHJ P,DWAIT +] + IDPB W,BYTPNT(A) ; ROOM EXISTS - PLACE COMMAND IN ARRAY +IFN PDP6F,[ JSR RELEASE +] + POPJ P, ; RETURN + +; ROUTINE TO HANDLE THE ARRAY FULL CONDITION +DSPFUL: SKIPGE ARYORG(A) + PUSHJ P,NOARY ;NON-EXISTENT ARRAY + PUSH P,B + MOVEI B,15. ;GROW BY 15. WORDS + ADD B,ARYL(A) ;TRY MORE ROOM + PUSHJ P,ARYALS + MOVEI B,15. + ADDM B,DSPLIM(A) ;MUST BE AFTER ARYALS TO RELOC IF ARRY MOVED + POP P,B + JRST DSPPTZ + +; ROUTINE WHICH PUTS THE DISPLAY INTO THE PROPER MODE + +MODPRM: MOVEI E,PARMOD ;ENTRY FOR PARAMETER MODE + JRST MODCHK + +MODCHR: MOVEI E,CHRMOD ; ENTRY FOR CHARACTER MODE + JRST MODCHK + +MODVEC: MOVEI E,VECMOD ; ENTRY FOR VECTOR MODE + JRST MODCHK + +MODPNT: MOVEI E,PNTMOD ; ENTRY FOR POINT MODE + +MODCHK: SKIPGE ARYORG(A) ; ARE WE REALLY WINNING? + PUSHJ P,NOARY ;NON-EXISTENT ARRAY + LDB X,DSPMOD ;GET CURRENT MODE + CAMN E,X ; COMPARE THE TWO VALUES + POPJ P, ; RETURN - NO CHANGE + + PUSH P,W + CAIGE X,CHRMOD ; CHECK CURRENT MODE TYPE + JRST MODFNX ; TYPE 0 OR 1 NEED NO SPECIAL HANDLING + CAIE X,CHRMOD ; CHECK FOR BEING IN CHARACTER MODE + JRST MODSPC ; NO - MUST BE MODE TYPE 4, 5, OR 6 + MOVEI W,37 ; PUT TERMINATION CHARACTER INTO THE BUFFER + PUSHJ P,DSPPUT + MOVE W,BYTPNT(A) ; GET BYTE POINTER + TLZ W,177700 ; SET BIT POINTER TO NEXT HALFWORD + TLNE W,200000 + TLO W,20000 + TLO W,2200 ; SET BYTE SIZE BACK TO HALFWORD + MOVEM W,BYTPNT(A) + JRST MODFIN + +MODSPC: MOVE W,BYTPNS(A) + CAMN W,BYTPNT(A) + JRST MODFNX ;HAVENT REALLY STORED ANY OF THIS FLAVOR + LDB W,BYTPNT(A) ; GET MOST RECENT HALFWORD + IORI W,400000 ; SET PROPER ESCAPE BIT + DPB W,BYTPNT(A) +MODFIN: MOVEI W,PARMOD ;PUT IT INTO PARAMETER MODE + DPB W,DSPMOD ;SET NEW MODE + MOVE W,E ;GET NEW VALUE OF MODE + LSH W,15 ;SHIFT BITS INTO PROPER POSITION + PUSHJ P,DSPPUT ; PUT SKELETON TYPE 0 COMMAND INTO THE BUFFER + JRST MODFNY ; CHECK TO SEE IF NEW MODE NEEDS SPECIAL HANDLING + +MODFNX: LDB X,BYTPNT(A) ; GET LAST COMMAND FROM THE ARRAY + ANDCMI X,160000; INSERT NEW MODE BITS + MOVE W,E + LSH W,15 ;SHIFT INTO PROPER POSITION + IOR X,W + DPB X,BYTPNT(A) ; PUT COMMAND BACK INTO THE ARRAY + JUMPE E,MODFIN ;INSERT SKEL TYPE 0 COMM + +MODFNY: POP P,W + DPB E,DSPMOD ; UPDATE MODE VALUE + CAIGE E,CHRMOD ; CHECK NEW MODE VALUE + POPJ P, ; RETURN - NEEDS NO SPECIAL HANDLING + + MOVE X,BYTPNT(A) ; SAVE SO CAN TELL IF ANY WDS IN THIS MODE REALLY STORED + MOVEM X,BYTPNS(A) + CAIE E,CHRMOD ; CHECK FOR NEW MODE BEING CHARACTER MODE + POPJ P, ; NOT CHARACTER - BETTER CHECK SOME MORE + MOVSI X,2400 ; SET BYTE POINTER TO HANDLE CHARACTERS + XORM X,BYTPNT(A) + POPJ P, ; RETURN + +POPBAJ: POP P,B +POPAJ: POP P,A +CPOPJ: POPJ P, +POPJP=CPOPJ + + +;INSERT GT40 STUFF IF NECESSARY +IFN GT40F,.INSRT SYSENG;FDITS > + + +CONST: CONSTANTS +VARIA: VARIABLES + +PDL: BLOCK LPDL ;PUSH DOWN LIST + +FSP: FS ;LAST PLACE IN PROGRAM + +IFE PDP6F,[ +CORTOP: CORSIZ*2000 ;SIZE NEEDED IN BLOCKS OF 2000 +CRSZ: CORSIZ ;# OF BLOCKS PROGRAM HAS +CRLM: CORSIZ ;# OF BLOCKS RETAINED +] +PAT: BLOCK 40 ;PATCH SPACE + +FS: +IFE PDP6F,[ +CORSIZ==<.+1777>_-10. +] + +END GO +  \ No newline at end of file