github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-21 02:08:50 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysen2/ld10.61
Lars Brinkhoff 88bf6d0461 LD10, Lisp display slave.
2018-05-15 20:58:42 +02:00

2887 lines
59 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;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 <AX+1>,-243(AX)
TERMIN
DEFINE FIX AX,AY
MULI AX,400
TSC AX,AX
ASH <AX+1>,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_-<FLGCH> ;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_-<FLGCH>++200_-<DISCH>+200_-<CLCH>+200_-<PDCH>
]
;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_-<FLGCH>
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

Reference in New Issue View Git Blame Copy Permalink