mirror of
https://github.com/PDP-10/its.git
synced 2026-02-05 08:04:38 +00:00
Build CROCK.
This commit is contained in:
Lars Brinkhoff
533
src/sysen1/crock.1008
Executable file
533
src/sysen1/crock.1008
Executable file
@@ -0,0 +1,533 @@
|
||||
; -*-MIDAS-*-
|
||||
|
||||
TITLE CROCK
|
||||
|
||||
; Original program hacked up by GLS
|
||||
; 10X/20X version hacked by KLH.
|
||||
; Some 10X modifications done by EAK.
|
||||
|
||||
if1 {
|
||||
its==1 ; can run on either ITS or
|
||||
tnx==1 ; 10X or 20X
|
||||
.insrt system
|
||||
}
|
||||
|
||||
; If not ITS, can't use ^P codes. Must define terminal type explicitly.
|
||||
ifndef t%its, t%its==its
|
||||
ifndef t%hz15, t%hz15==0 ; Hazeltine 1500
|
||||
ifndef t%dm25, t%dm25==0 ; Datamedia 2500
|
||||
ifndef t%vt52, t%vt52==0 ; VT52
|
||||
ife t%its\t%hz15\t%dm25\t%vt52, t%vt52==1 ; default to vt52
|
||||
|
||||
|
||||
; ACC DEFINITIONS
|
||||
|
||||
H=1 ;HOURS IN 6-DEGREE UNITS - Don't change this assignment!
|
||||
M=H+1 ;MINUTES (don't change these either)
|
||||
S=M+1 ;SECONDS
|
||||
|
||||
B=4 ;OUTPUT BUFFER POINTER
|
||||
HC=5 ;HORIZ CURSOR POS
|
||||
VC=6 ;VERT CURSOR POS
|
||||
;R=7 ; now unused.
|
||||
T=10 ;TEMP
|
||||
TT=11 ;TEMP
|
||||
Q=12 ;HOLDS 3-BIT BYTE FROM SOME HAND
|
||||
C=13 ;POINTS TO INSTR TO FETCH CHAR
|
||||
A=14 ;AOBJN PTR FOR TESTING OVERWRITE
|
||||
Z=15 ;AOBJN PTR FOR SAVING UP NEW DATA
|
||||
N=16 ;BYTE PTR FOR LOADING Q
|
||||
P=17 ; PDL ptr
|
||||
|
||||
|
||||
call=pushj p,
|
||||
return=popj p,
|
||||
|
||||
ifn 20x,{
|
||||
TM%DPY=1_35.
|
||||
VTSOP=JSYS 635
|
||||
RTMOD=JSYS 636
|
||||
STMOD=JSYS 637
|
||||
RTCHR=JSYS 640
|
||||
}
|
||||
|
||||
ifn its,{
|
||||
ttyc=17 ;TTY output channel
|
||||
}
|
||||
ifn 10x,{
|
||||
.ttdm==14
|
||||
.ttv52==10.
|
||||
}
|
||||
ifn 20x,{
|
||||
.ttdm==5
|
||||
}
|
||||
|
||||
ifn tnx, oldmod: 0
|
||||
|
||||
pdl: -40,,pdl
|
||||
block 40
|
||||
|
||||
crock: move p,pdl ; set up PDL
|
||||
ifn its,[
|
||||
.open ttyc,[%tjdis+.uao,,'tty]
|
||||
.lose %lsfil
|
||||
]
|
||||
ifn tnx,[
|
||||
ifn t%dm25,[
|
||||
movei 1,.cttrm
|
||||
gttyp
|
||||
caie 2,.ttdm ; datamedia?
|
||||
jrst [ hrroi 1,[asciz "?Currently works only on datamedias"]
|
||||
psout
|
||||
haltf
|
||||
jrst .+1] ; If continued, go ahead.
|
||||
] ; ifn t%dm25
|
||||
ifn t%vt52,[
|
||||
movei 1,.cttrm
|
||||
gttyp
|
||||
caie 2,.ttv52 ; VT52?
|
||||
jrst [ hrroi 1,[asciz "?Currently works only on VT52s"]
|
||||
psout
|
||||
haltf
|
||||
jrst .+1] ; If continued, go ahead.
|
||||
] ; ifn t%vt52
|
||||
movei 1,.priin
|
||||
rfmod
|
||||
movem 2,oldmod ; save old status
|
||||
trz 2,tt%dam ; set to 8-bit i/o
|
||||
ifn t%its,{ ; VTS
|
||||
tro 2,1_7 ; turn on output translation
|
||||
}
|
||||
sfmod ; zap
|
||||
ifn t%its,{
|
||||
rtmod
|
||||
tlo 2,(tm%dpy)
|
||||
stmod
|
||||
}
|
||||
]
|
||||
; Output initial clock picture
|
||||
move 2,[440700,,ibuf] ; bp to cruft
|
||||
ifn its,[
|
||||
movei 3,libuf ; cnt of bytes (pos)
|
||||
.call [setz ? sixbit /siot/ ? 1000,,ttyc
|
||||
2 ? setz 3]
|
||||
.value
|
||||
]
|
||||
ifn tnx,[
|
||||
movni 3,libuf ; TNX has it backwards - negative cnt
|
||||
movei 1,.priou
|
||||
; pushj p,cpsout ; Perform SOUT simulation for ^P codes
|
||||
sout
|
||||
]
|
||||
SETOM OLDH
|
||||
SETOM OLDM
|
||||
SETOM OLDS
|
||||
SETZB H,M
|
||||
SETZB S,HPOSH
|
||||
MOVE T,[HPOSH,,HPOSH+1]
|
||||
BLT T,EPOS
|
||||
|
||||
; Start a new clock picture here
|
||||
LOOP:
|
||||
ifn its,[ ; Get ITS time into H,M,S
|
||||
.RTIME TT,
|
||||
IRPC X,,[HMS]
|
||||
ROTC T,6
|
||||
TRZ T,777760
|
||||
IMULI T,10.
|
||||
MOVEI X,(T)
|
||||
ROTC T,6
|
||||
TRZ T,777760
|
||||
ADDI X,(T)
|
||||
TERMIN
|
||||
]
|
||||
ifn tnx,[ ; Get TNX time into H,M,S (must be 1,2,3!)
|
||||
seto 2, ; get current time
|
||||
setz 4, ; with no funny daylight savings or timezone stuff
|
||||
odcnv ; get time
|
||||
movei h,(4) ; get # secs since midnite into H (from RH of 4)
|
||||
idivi h,60.*60. ; get # hours in 1
|
||||
idivi m,60. ; get # mins in 2, # secs in 3
|
||||
]
|
||||
MOVEI T,(H)
|
||||
IDIVI T,12.
|
||||
MOVEI H,(TT)
|
||||
IMULI H,5
|
||||
MOVEI T,(M)
|
||||
IDIVI T,12.
|
||||
ADDI H,(T)
|
||||
MOVE B,[440700,,BUF]
|
||||
IRPC X,,[HMS]
|
||||
CAMN X,OLD!X
|
||||
JRST FOO!X ; no need to draw anything
|
||||
SKIPGE T,OLD!X
|
||||
JRST BAR!X ; if neg, skip erasing (first-time)
|
||||
MOVE C,[5+.IRPCNT,,CHKILL]
|
||||
MOVE A,X!PTR
|
||||
SETZ Z,
|
||||
PUSHJ P,DRAW
|
||||
BAR!X: MOVEI T,(X)
|
||||
MOVE C,[5+.IRPCNT,,X!CHAR]
|
||||
MOVE A,X!PTR
|
||||
MOVE Z,PTR!X
|
||||
PUSHJ P,DRAW
|
||||
MOVEM X,OLD!X
|
||||
FOO!X:
|
||||
TERMIN
|
||||
move 2,b
|
||||
subi 2,buf ; get bp rel to start of buffer
|
||||
muli 2,5 ; set up for...
|
||||
add 3,uadbp7(2) ; finding # chars in buffer.
|
||||
caile 3,lbufch ; make sure it didn't exceed bounds
|
||||
ifn its, .lose 0
|
||||
ifn tnx, jrst 4,
|
||||
|
||||
; Now before outputting, make sure user hasn't typed anything.
|
||||
ifn its,{
|
||||
.listen t,
|
||||
jumpn t,die ; Input buff not empty, go die.
|
||||
}
|
||||
ifn tnx,{
|
||||
movei 1,.priin
|
||||
sibe
|
||||
jrst die ; Input buff not empty, go die.
|
||||
}
|
||||
|
||||
; No input, go ahead and chunk the stuff out!
|
||||
jumpe 3,slptic ; Unless of course nothing to output.
|
||||
move 2,[440700,,buf] ; BP for output
|
||||
ifn its,[
|
||||
.call [setz ? sixbit /siot/ ? 1000,,ttyc
|
||||
2 ? setz 3]
|
||||
.value
|
||||
]
|
||||
ifn tnx,[
|
||||
movni 3,(3) ; Get neg count
|
||||
movei 1,.priou
|
||||
; pushj p,cpsout ; simulate SOUT for ^P codes.
|
||||
sout
|
||||
]
|
||||
|
||||
; Now sleep for one second before looping again.
|
||||
slptic:
|
||||
ifn its,{
|
||||
movei tt,30
|
||||
.sleep tt,
|
||||
}
|
||||
ifn tnx,{
|
||||
movei 1,1000.
|
||||
disms
|
||||
}
|
||||
jrst loop
|
||||
|
||||
die:
|
||||
ifn its, .break 16,140000
|
||||
ifn tnx,[
|
||||
ife t%its,{
|
||||
movei 1,.priou ; Before halting, move to bottom of screen.
|
||||
ifn t%dm25, hrroi 2,[.byte 7 ? ^L ? 0#140 ? 23.#140 ? ^M ? 0]
|
||||
ifn t%hz15, hrroi 2,[.byte 7 ? 176 ? ^Q ? 140 ? 23.+140 ? ^M ? 0]
|
||||
ifn t%vt52, hrroi 2,[asciz "Y7 K"]
|
||||
setz 3,
|
||||
sout
|
||||
}
|
||||
movei 1,.priin
|
||||
move 2,oldmod
|
||||
sfmod ; Restore old modes
|
||||
haltf
|
||||
jrst crock
|
||||
]
|
||||
|
||||
; Super hairy hand drawer.
|
||||
; Inputs are:
|
||||
; T - value (0-59) of hand to draw
|
||||
; C - points to instr to fetch char
|
||||
; A - aobjn ptr for testing overwrite, from HPTR, MPTR, or SPTR.
|
||||
; Z - 0 if erasing, else aobjn ptr for saving up new data.(PTRH,PTRM, or PTRS)
|
||||
; B - BP to deposit stuff in buffer (7-bit)
|
||||
; Other acs used are:
|
||||
; N - BP for loading Q
|
||||
; Q - 3-bit byte from HANDnn tables
|
||||
; HC - Horiz cursor pos, plus 8
|
||||
; VC - Vert cursor pos, plus 8
|
||||
|
||||
DRAW: SETOM OLDHC ; zap old cursor positions so always move first thing.
|
||||
SETOM OLDVC
|
||||
MOVEI HC,10+20. ; desired cursor pos begins at center of clock.
|
||||
MOVEI VC,10+11.
|
||||
IDIVI T,15. ; Find quadrant hand is in (0,1,2,3 clockwise)
|
||||
TRNE T,1 ; if in quad 1 or 3,
|
||||
MOVNI TT,-15.(TT) ; set remainder to mirror image of that for 0 or 2
|
||||
MOVE N,HANDTB(TT) ; using remainder, get proper hand-slope.
|
||||
|
||||
; Loop once for each hand position.
|
||||
DRAW9: ILDB Q,N ; Get 1st byte of hand
|
||||
XCT VINCR(T) ; add or subtract vertical movement by Q positions.
|
||||
ILDB Q,N ; get 2nd byte,
|
||||
XCT HINCR(T) ; add or subtract horiz movement by Q positions.
|
||||
ILDB Q,N ; now check 3rd byte of position
|
||||
CAIGE Q,5 ; Is it a special marker?
|
||||
JRST DRAW0 ; No, go continue hacking normally.
|
||||
|
||||
; Special marker seen in hand description, check it
|
||||
HLRZ TT,C ; get type of hand being done
|
||||
CAIE TT,(Q) ; If same, we've hit end of road for this hand.
|
||||
JRST DRAW9 ; not same, continue drawing hand.
|
||||
|
||||
; Stop drawing hand.
|
||||
JUMPGE Z,APOPJ ; if erasing or all positions covered, done - return.
|
||||
SETOM (Z) ; else must zap remaining positions in
|
||||
SETOM POSX(Z) ; POSH and POSV tables.
|
||||
AOBJN Z,.-2
|
||||
APOPJ: POPJ P,
|
||||
|
||||
; Output a char of the hand in current HC,VC cursor position if safe.
|
||||
DRAW0: JUMPE A,DRAW2 ;If ptr to overwrite table 0, don't bother checking.
|
||||
MOVE TT,A ; Else must check, get copy for munging in TT.
|
||||
DRAW1: CAMN HC,(TT) ; current X matches anything in table?
|
||||
CAME VC,POSX(TT) ; if X matches, does Y also match? If both do match,
|
||||
CAIA
|
||||
JRST DRAW9 ; then this position occupied already! Don't write.
|
||||
AOBJN TT,DRAW1
|
||||
|
||||
; Safe, can actually output char.
|
||||
DRAW2:
|
||||
ifn t%its,[
|
||||
IRPC W,,[HV]
|
||||
CAMN W!C,OLD!W!C
|
||||
JRST QUUX!W
|
||||
MOVEI TT,^P
|
||||
IDPB TT,B
|
||||
MOVEI TT,"W
|
||||
IDPB TT,B
|
||||
IDPB W!C,B
|
||||
MOVEM W!C,OLD!W!C
|
||||
QUUX!W:
|
||||
TERMIN
|
||||
]
|
||||
ife t%its,[
|
||||
camn hc,oldhc ; see if either different from old.
|
||||
came vc,oldvc
|
||||
caia ; one of them different, must send coords
|
||||
jrst quuxv ; Nope, same, can skip positioning.
|
||||
|
||||
; Must send new coords, HC and VC. Note that these are +8 !!
|
||||
movem hc,oldhc ; Save old
|
||||
movem vc,oldvc
|
||||
|
||||
ifn t%dm25,[
|
||||
movei tt,^L ; dm2500 abs move
|
||||
idpb tt,b
|
||||
movei tt,-10(hc) ; move to scratch reg, flushing +8 lossage.
|
||||
trc tt,140
|
||||
idpb tt,b
|
||||
movei tt,-10(vc)
|
||||
trc tt,140
|
||||
idpb tt,b
|
||||
]
|
||||
ifn t%hz15,[ ; H1500 abs move
|
||||
movei tt,176 ; leadin
|
||||
idpb tt,b
|
||||
movei tt,^Q
|
||||
idpb tt,b
|
||||
movei tt,(hc)
|
||||
caige tt,40
|
||||
addi tt,140
|
||||
idpb tt,b
|
||||
movei tt,140(vc)
|
||||
idpb tt,b
|
||||
]
|
||||
ifn t%vt52,[
|
||||
movei tt,33
|
||||
idpb tt,b
|
||||
movei tt,"Y
|
||||
idpb tt,b
|
||||
movei tt,40-10(vc)
|
||||
idpb tt,b
|
||||
movei tt,40-10(hc)
|
||||
idpb tt,b
|
||||
]
|
||||
quuxv:
|
||||
]
|
||||
AOS OLDHC ; always bump horiz pos since output will move cursor.
|
||||
XCT (C) ; Get appropriate char for this hand.
|
||||
JRST ZAPZAP ; If it skips, means char should be killed...
|
||||
ifn its&t%its,[ ; This stuff actually only needed for terms
|
||||
MOVEI TT,^P ; that can overprint.
|
||||
IDPB TT,B
|
||||
MOVEI TT,"K
|
||||
IDPB TT,B
|
||||
]
|
||||
MOVEI TT,40 ; for other non-overprinting terms, a space suffices.
|
||||
ZAPZAP: IDPB TT,B ; store output char (at long last)
|
||||
JUMPGE Z,DRAW9 ; if erasing or hit end of table, don't remember pos.
|
||||
MOVEM HC,(Z) ; otherwise do remember it - save new H pos
|
||||
MOVEM VC,POSX(Z) ; and V pos
|
||||
AOBJN Z,DRAW9 ; and bump down table count and draw another char
|
||||
POPJ P, ; unless out of room.
|
||||
|
||||
; Table for quickly deriving char addr of a BP
|
||||
133500,,0 ; to handle -5 produced by 440700
|
||||
repeat 4,0
|
||||
UADBP7: -54300,,5
|
||||
-104300,,4
|
||||
-134300,,3
|
||||
-164300,,2
|
||||
-214300,,1
|
||||
|
||||
|
||||
OLDH: 0
|
||||
OLDM: 0
|
||||
OLDS: 0
|
||||
OLDHC: 0
|
||||
OLDVC: 0
|
||||
|
||||
CHKILL: CAIA
|
||||
HCHAR: MOVEI TT,"*
|
||||
MCHAR: MOVEI TT,"O
|
||||
SCHAR: LDB TT,.+1(Q) ; char used for sec hand is selected by 3rd byte
|
||||
350700,,CHARS(T) ; (also depending on quadrant)
|
||||
260700,,CHARS(T)
|
||||
170700,,CHARS(T)
|
||||
100700,,CHARS(T)
|
||||
010700,,CHARS(T)
|
||||
|
||||
CHARS: ASCII #I-/',#
|
||||
ASCII #I-\,'#
|
||||
ASCII #I-/,'#
|
||||
ASCII #I-\',#
|
||||
|
||||
VINCR: SUBI VC,(Q)
|
||||
ADDI VC,(Q)
|
||||
ADDI VC,(Q)
|
||||
SUBI VC,(Q)
|
||||
|
||||
HINCR: ADDI HC,(Q)
|
||||
ADDI HC,(Q)
|
||||
SUBI HC,(Q)
|
||||
SUBI HC,(Q)
|
||||
|
||||
HPOSH: BLOCK 12.
|
||||
MPOSH: BLOCK 18.
|
||||
HPOSV: BLOCK 12.
|
||||
MPOSV: BLOCK 18.
|
||||
EPOS==.-1
|
||||
POSX==HPOSV-HPOSH
|
||||
|
||||
HPTR: 0
|
||||
MPTR: -12.,,HPOSH
|
||||
SPTR: -30.,,HPOSH
|
||||
|
||||
PTRH: -12.,,HPOSH
|
||||
PTRM: -18.,,MPOSH
|
||||
PTRS: 434343 ;ANYTHING >0 IS OKAY!
|
||||
|
||||
DEFINE IHACK X
|
||||
IRPC W,,[X]
|
||||
IFE "W-"F, %H==%H+1
|
||||
IFE "W-"U, %V==%V-1
|
||||
IFE "W-"B, %H==%H-1
|
||||
IFE "W-"D, %V==%V+1
|
||||
IFL "W-"@,[ ; Check for doing abs positioning.
|
||||
ifn t%its, IFN %H-$H, ^P ? "H ? 10+%H
|
||||
ifn t%its, IFN %V-$V, ^P ? "V ? 10+%V
|
||||
ifn t%dm25, IFN <%H-$H>\<%V-$V>, ^L ? %H#140 ? %V#140 ; Abs positioning
|
||||
ifn t%hz15,[IFN <%H-$H>\<%V-$V>,[
|
||||
176 ? ^Q
|
||||
ifl %H-40,{140+%H} .else %H
|
||||
%V+140]]
|
||||
ifn t%vt52, ifn <%h-$h>\<%v-$v>, 33 ? "Y ? %v+40 ? %h+40
|
||||
"W
|
||||
%H==%H+1
|
||||
$H==%H
|
||||
$V==%V
|
||||
]
|
||||
TERMIN
|
||||
TERMIN
|
||||
|
||||
$H==-1
|
||||
$V==-1
|
||||
%H==0
|
||||
%V==0
|
||||
|
||||
; Cruft sent out to terminal at initial startup.
|
||||
IBUF:
|
||||
.BYTE 7 ; First thing is to clear screen
|
||||
ifn t%its, ^P ? "C
|
||||
ifn t%dm25, ^^ ? ^^ ; twice required at 9600 baud
|
||||
ifn t%hz15, 176 ? 34
|
||||
ifn t%vt52, 33 ? "H ? 33 ? "J
|
||||
IHACK [FFFFFFFFF11F,F,F,F,12F,F,F,F,FF1]
|
||||
IHACK [FD'FD'FD'FD'D2BD,BD,BDD'BD'BD3]
|
||||
IHACK [BD,BD,BDD'BD'BD4BBD,BBBD,BBBD,BBBD,BBBD5]
|
||||
IHACK [BBBB'BBB'BBB'BBB'BBB6BBB'BBB'BBB'BBB'BBBB7]
|
||||
IHACK [BBBU,BBBU,BBBU,BBBU,BBU8BU'BU'BUU,BU,BU9]
|
||||
IHACK [BU'BU'BUU,BU,BU10BU'FU'FU'FU']
|
||||
; Picture done, now one more abs-pos to middle.
|
||||
ifn t%its, ^P ? "H ? 10+20. ? ^P ? "V ? 10+11.
|
||||
ifn t%dm25, ^L ? 20.#140 ? 11.#140
|
||||
ifn t%hz15, 176 ? ^Q ? 20.+140 ? 11.+140
|
||||
ifn t%vt52, 33 ? "Y ? 11.+40 ? 20.+40
|
||||
"*
|
||||
|
||||
libuf==.bytc ; Get # bytes in initial buffer picture.
|
||||
.BYTE
|
||||
|
||||
|
||||
DEFINE HAND X
|
||||
.BYTE 9
|
||||
IRPS F,G,[X]
|
||||
F
|
||||
IFSE G,", 005
|
||||
IFSE G,', 006
|
||||
TERMIN
|
||||
007
|
||||
.BYTE
|
||||
TERMIN
|
||||
|
||||
HANDTB: 440300,,HAND0
|
||||
440300,,HAND1
|
||||
440300,,HAND2
|
||||
440300,,HAND3
|
||||
440300,,HAND4
|
||||
440300,,HAND5
|
||||
440300,,HAND6
|
||||
440300,,HAND7
|
||||
440300,,HAND8
|
||||
440300,,HAND9
|
||||
440300,,HAND10
|
||||
440300,,HAND11
|
||||
440300,,HAND12
|
||||
440300,,HAND13
|
||||
440300,,HAND14
|
||||
440300,,HAND15
|
||||
|
||||
HAND0: HAND 100 100 100 100 100 100"100 100 100'100
|
||||
HAND1: HAND 100 100 102 110 100 100"102 110 100'100
|
||||
HAND2: HAND 100 102 110 102 110 102"110 102 110'100
|
||||
HAND3: HAND 100 112 112 110 102 110"102 110 102'110
|
||||
HAND4: HAND 112 112 110 102 112 110"102 112 112'110
|
||||
HAND5: HAND 112 112 112 112 112 112"112 112 112'112
|
||||
HAND6: HAND 112 112 112 114 013 112 112"114 013 112'112 114
|
||||
HAND7: HAND 114 013 112 114 013 112 114 013"112 114 013 112'114 013
|
||||
HAND8: HAND 013 114 013 114 013 114 013 114 013 114"013 114 013 114'013 114
|
||||
HAND9: HAND 013 112 013 114 013 114 011 013 114 011 013"112 114 011 013 114'011 013
|
||||
HAND10: HAND 011 013 114 011 013 114 011 013 114 011 013"114 011 013 114 011 013'114
|
||||
HAND11: HAND 011 013 114 011 011 013 114 011 011 013 114"011 011 013 114 011 011'013 114
|
||||
HAND12: HAND 011 011 013 114 014 011 011 013 114 014 011"011 013 114 014 011 011'013 114
|
||||
HAND13: HAND 011 011 011 013 013 114 014 011 011 011 013"013 114 014 011 011 011'013 013
|
||||
HAND14: HAND 011 011 011 011 013 013 013 013 114 014 014"014 011 011 011 011 013'013 013
|
||||
HAND15: HAND 011 011 011 011 011 011 011 011 011 011 011"011 011 011 011 011 011'011 011
|
||||
|
||||
PATCH: BLOCK 20
|
||||
|
||||
litter:
|
||||
constants
|
||||
variables
|
||||
|
||||
lbufch==<6*20.*7>+20 ; calculated plus 20 characters safety margin
|
||||
buf: block <lbufch+4>/5
|
||||
|
||||
ifn its, -1 ; to ensure core loaded.
|
||||
|
||||
end crock
|
||||
Reference in New Issue
Block a user