github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-25 09:52:18 +00:00
Code Issues Releases Wiki Activity
Files
e10d1a98c379051064ba8121a875953051debeeb
PDP-10.its/src/draw/sub.501
Lars Brinkhoff 33074b453f SUDS - Stanford University Drawing System.
2018-05-05 19:19:09 +02:00

4127 lines
69 KiB
Plaintext
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.
;<DRAW>SUB.FAI.205, 26-NOV-75 17:02:15, EDIT BY HELLIWELL
VERSION(SUB,18)
;HERE WE SAVE DUMP FILES OF ALL SORTS
LAY,<
RSAVEM: TROA TFLG
>;LAY
SAVEME:
LAY,< TRZ TFLG >
IFN DECSW!IIISW,<
TLNE M,DSKFLG
JRST [ OUTSTR[ASCIZ/SORRY, DSKIN ACTIVE!
/]
POPJ P,]
>;IFN DECSW!IIISW
NODEC,<
NOIII,<
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/DISK SAVE /]
LAY,< MOVE H,SAVNAM
EXCH H,LSTNAM ;USE THIS AS LSTNAM FOR NOW
MOVE G,SAVPPN
EXCH G,LSTPPN
MOVE F,SAVEXT
EXCH F,LSTEXT
>;LAY
MOVSI T,EXTSAV
PUSHJ P,SETNAM
NOLAY,< POPJ P, >
LAY,< JRST [ MOVEM H,LSTNAM ;CHANGED HIS MIND, RESTORE LSTNAM
MOVEM G,LSTPPN
MOVEM F,LSTEXT
POPJ P,]
MOVEM H,LSTNAM
MOVEM G,LSTPPN
MOVEM F,LSTEXT
>;LAY
ENTPPN
ESAVEM:
MOVE T,[FILNAM,,DPCNAM]
BLT T,DPCPPN
INIT DAT,17
'DSK '
0
JRST [ OUTSTR[ASCIZ/CAN'T GET DISK FOR EXISTS CHECK!
/]
POPJ P,]
PUSHJ P,EXIST
POPJ P, ;LET HIM OUT
RELEASE DAT,
PUSH P,0
PUSH P,M
PUSHJ P,PUSHIT
MOVEM P,SSSP
LAY,< TRNE TFLG
SKIPA T,[.STRTN] ;START FROM TOP ON RESAVE
>;LAY
MOVEI T,CONTLC
MOVEM T,STRTLC
NOLAY,< JSR SVREST >
LAY,<
MD,< JSR DOSAVD >
MPC,< JSR DOSAVP >
>;LAY
CAIA ;LOSE, CRLF ALREADY OUT
OUTSTR[ASCIZ/
/] ;WIN, NEED CRLF
>;NOIII
>;NODEC
III,< PUSH P,0
PUSH P,M
PUSHJ P,PUSHIT
MOVEM P,SSSP
>;III
IFN DECSW!IIISW,<
MOVEI T,CONTLC
HRRM T,.JBSA
OUTSTR[ASCIZ/SAVE CORE IMAGE WITH "SAVE" COMMAND,
THEN TYPE "START" OR "RUN".
/]
DEC,< PUSHJ P,CTRLCS > ;SIMULATE CONTROL-C
III,< EXIT 1, >
>;INF DECSW!IIISW
NODEC,<
MOVE P,SSSP
PUSHJ P,POPIT
POP P,M
POP P,0
>;NODEC
JRST SAVCON
NOLAY,<CONTLC:>
CNTSAV:
DEC,< JSP T,CTRLCX > ;CALL CONTROL-C EXIT ROUTINE
LAY,<
MD,< OUTSTR[ASCIZ/LAYOUT, D SIDE!
/]
>;MD
MPC,< OUTSTR[ASCIZ/LAYOUT, PC SIDE!
/]
>;MPC
>;LAY
NODEC,<
MOVE P,SSSP
PUSHJ P,POPIT
POP P,M
POP P,0
PUSHJ P,DCLAIM ;RECLAIM DISPLAY FOR EVERYONE ELSE (DEC DONE IN CTRLC CODE)
>;NODEC
DEC,< PUSHJ P,CLTIME > ;RE INIT TIME CELLS
SAVCON:
NODEC,<
NOIII,< MOVE T,DPCNAM
NOLAY,< MOVEM T,LSTNAM ;UPDATE  >
LAY,< MOVEM T,SAVNAM >
MOVE T,DPCPPN
NOLAY,< MOVEM T,LSTPPN >
LAY,< MOVEM T,SAVPPN >
MOVE T,DPCEXT
NOLAY,< MOVEM T,LSTEXT >
LAY,< MOVEM T,SAVEXT >
JRST FILEUP
>;NOIII
>;NODEC
IFN DECSW!IIISW,<
MOVEI T,STRT
HRRM T,.JBSA
POPJ P,
>;IFN DECSW!IIISW
;ESAVE, EWRITE, SETSM, SETWM, MAKEWD
NODEC,<
NOIII,<
ESAVE: MOVE T,AUTOSM
MOVEM T,AUTOSN ;UPDATE AUTO-SAVE COUNTER
LAY,< SKIPN T,SAVNAM >
NOLAY,< SKIPN T,LSTNAM >
JRST [ OUTSTR[ASCIZ/NO REMEMBERED NAME AT ESAVE!
/]
POPJ P,]
MOVEM T,FILNAM
SETOM THEREXISTS
MOVSI T,EXTSAV
MOVEM T,FILEXT
SETZB T,FILDAT
LAY,< MOVE T,SAVPPN >
NOLAY,< MOVE T,LSTPPN >
MOVEM T,FILPPN
JRST ESAVEM
SETSM: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NUMBER OF COMMANDS BETWEEN ESAVES?/]
PUSHJ P,READNC
MOVEM T,AUTOSM
MOVEM T,AUTOSN
POPJ P,
CLRSM: SETZM AUTOSM
POPJ P,
>;NOIII
>;NODEC
SETWM: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NUMBER OF COMMANDS BETWEEN EWRITES?/]
PUSHJ P,READNC
MOVEM T,AUTOWM
MOVEM T,AUTOWN
POPJ P,
CLRWM: SETZM AUTOWM
POPJ P,
MAKWIR: MOVEI T,BODM
PUSHJ P,CHNGMD
PUSHJ P,XCLEAR
OUTSTR[ASCIZ/BODY MODE, CLEAR.
/]
MOVEM P,PERRSAV
MOVSI T,EXTFIL
PUSHJ P,SETNAM
POPJ P,
INIT DAT,17
'DSK '
0
JRST [ OUTSTR[ASCIZ/CAN'T GET DISK!
/]
POPJ P,]
MOVSI G,EXTWIR
EXCH G,FILEXT
SETZ H,
DSKPPN H, ;WILL WRITE 'WD' FILE ON CURRENT AREA
EXCH H,FILPPN
OUTSTR[ASCIZ/READING DATE FROM /]
MOVEI A,FILNAM
JSR FPRINT
MOVE T,FILPPN
LOOKUP DAT,FILNAM
JRST [ HRRZ TT,FILEXT
JUMPN TT,LOOKRR
SETZM FILDAT
JRST MAKWR1]
DEC,< JSR DAT,LOOKCK >
NODEC,< MOVEM T,FILPPN >
MAKWR1: OUTSTR[ASCIZ/
/]
MOVE T,FILDAT
LDB TT,[POINT 3,FILEXT,20]
DPB TT,[POINT 6,T,23]
HRLZM T,WIRDAT
LDB T,[POINT 11,FILDAT,23]
HRRM T,WIRDAT
MOVEM G,FILEXT
MOVEM H,FILPPN
RELEASE DAT,
TLZ M,TYPREP!TYPNLY
PUSHJ P,WIRENT
SKIPN LSTNAM
POPJ P, ;LOST, OR WD FILE NOT NEEDED
JRST EWLIST
;REENTER CODE
%R: MOVEM T,RSAVET ;SAVE T HERE FOR NOW!
DEC,<
NOGT,<
MOVEI T,0
SETUWP T, ;UNWRITEPROTECT THE HIGH SEGMENT
JFCL
>;NOGT
>;DEC
MOVE T,P ;SAVE STACK HERE A SEC
MOVE P,[IOWD SPPDSZ,SPPDL] ;NOW GET A GOOD ONE (IN CASE OF PDLOV)
PUSH P,T ;NOW SAVE STACK ON STACK
OUTSTR [ASCIZ /
IF YOU TYPE "N", THE PROGRAM WILL BE CONTINUED WHERE IT LEFT OFF.
YOU WILL BE GIVEN A CHANCE TO STOP MACROS CURRENTLY BEING EXECUTED.
IF YOU TYPE "Y", THE PROGRAM WILL BE STARTED IN THE COMMAND LOOP, AND
ALL MACROS CURRENTLY BEING EXECUTED WILL BE STOPPED.
NOTE: TYPING "Y" HAS A FINITE PROBABILITY OF MUNGING THE DATA STRUCTURE.
TYPE "Y" OR "N"? /]
PUSHJ P,TTYORN
CAIA
JRST REINIT
POP P,P ;NOT RESTARTING, ASSUME STACK GOOD
MOVE T,RSAVET
PUSHJ P,PUSHIT
OUTSTR[ASCIZ/FLUSH MACROS IN PROGRESS? /]
PUSHJ P,TTYORN
CAIA
PUSHJ P,ABMAC
NODEC,< PUSHJ P,DCLAIM > ;RE-SETUP DISPLAY STUFF
PUSHJ P,POPIT
R: JRST @.JBOPC
TTYORN: TTYUUO 4,T
PUSH P,T
TTYRN1: TTYUUO 4,T
CAIE T,12 ;GOBBLE TO END OF LINE
JRST TTYRN1
POP P,T
CAIE T,"Y"+40
CAIN T,"Y"
AOS (P)
POPJ P,
MPC,<
GOTPNT: FETCHL(SID,T,PBIT)
TLZ SID,777777-FRONT
POPJ P,
>;MPC
REINIT: MOVE P,[IOWD PDLEN,PDL] ;REQUESTING PSEUDO START
MOVE 0,SAVER0
TRO MCHG!NEEDCL
MOVE M,SAVERM
SETZM DSKOPN
RELEASE ODSK, ;GIVE LOG FILE A CHANCE TO BE RESTARTED
PUSHJ P,ABMAC ;FLUSH MACROES
DEC,< PUSHJ P,DECGO >
PUSHJ P,DCLAIM
DEC,< PUSHJ P,LOGINI >
PUSHJ P,RCHNGM ;RESTORE OMODE
MPC,< SETZ SID,
SKIPE T,PONPNT
PUSHJ P,GOTPNT
TLC SID,FRONT
SKIPE T,PONPN2
PUSHJ P,GOTPNT
TLC SID,FRONT
>;MPC
JRST MAIN
SUBTTL FREE STORAGE ROUTINES
;An appeal for more core....
DEFINE DOCORE(AC,FAIL)
<
III,< PUSH P,AC
MOVEI AC,1
UNLOK. AC,
JFCL
POP P,AC
>;III
NOTWO,< CORE AC, >
TWO,< CORE2 AC, >
JRST [ JSR NOCORE
JRST FAIL]
III,< MOVEI AC,1
LOCK AC,
JFCL
>;III
>;docore
;Get core for old style free storage - 2 wd blocks
NOFSTA: MOVEM A,SAVEA
MOVEM B,SAVEB
NOFST3: GETREL A
ADDI A,1
MOVEM A,FSTPNT
ADDI A,1777
VB10,< MOVSI A,(A)>
DOCORE(A,NOFST3) ;get a coreblock
;build free list to end of new block
MOVE A,FSTPNT
GETREL B
NOFST1: ADDI A,2
CAIG A,(B)
JRST [ HRRZM A,-2(A)
JRST NOFST1]
HRLI A,[0]
HLRZM A,-2(A) ;LINK END OF LIST TO 0
SOS NOFST
SOS NOFST
MOVE B,SAVEB
MOVE A,SAVEA
JRST @NOFST
;NOBLK - GET FREE STORAGE BLOCK
; SKIPN AC,@BLKPNT+SIZE
; JSR NOBLK
; EXCH AC,BLKPNT+SIZE
COMMENT 
BLOCK STORAGE IS ALLOCATED SEQUENTIALLY OUT OF A 1K FREE AREA
_________________
! !
! used !
BLKTOP -------------> ! ------------- ! ----
! !
! FREE ! BLKFRE WORDS
! !
! !
! ! 
----------------- ----
A NEW 1K IS ADDED IF THE BLOCK SIZE WON'T FIT, BUT IT IS
TACKED ON THE END OF THE OLD 1K IF THE OLD 1K WAS AT THE TOP
OF FREE CORE.

NOBLKA: MOVEM A,SAVEA
MOVEM B,SAVEB
NOBLK2: HRRZ B,@NOBLK ;GET PTR INTO BLK TABLE
HRRZ A,BLKFRE ;# FREE WORDS LEFT IN THIS GULP
CAIL A,-BLKPNT(B) ;BIG ENOUGH FOR BLOCK?
JRST NOBOK ;YES
NOBLK1: GETREL A ;HIGH PTR
MOVE B,A
XOR B,BLKTOP ;CURRENTLY ALLOCATING RIGHT AT TOP?
TRNE B,-2000
SETZM BLKFRE ;NO, START NEW GULP
ADDI A,1
MOVE B,A ;SAVE LOCN OF NEW 1K
DOCORE(A,NOBLK1) ;Get a coreblock from system
SKIPN BLKFRE ;ADDING ON TO OLD BLK?
MOVEM B,BLKTOP ;NO, START FROM BEGINNING OF NEW 1K THEN
MOVEI A,2000 ;WE GOT 2000 NEW WORDS
ADDM A,BLKFRE
JRST NOBLK2 ;TRY AGAIN
NOBOK: MOVE A,BLKTOP ;PTR TO ADDED BLOCK
EXCH A,(B) ;PUT IT ON FREE LIST(SIZE)
HRRZM A,@(B) ;PUT BACK [0] AT END
MOVEI A,-BLKPNT(B) ;LENGTH OF BLOCK
ADDM A,BLKTOP ;CONSUME STORAGE
MOVNS A
ADDM A,BLKFRE
MOVE B,SAVEB
MOVE A,SAVEA
SOS NOBLK
SOS NOBLK
JRST @NOBLK
BLKINI: MOVEI T,[0] ;INITIALIZE FREE LISTS TO NULL
MOVEM T,BLKPNT
MOVE T,[BLKPNT,,BLKPNT+1]
BLT T,BLKPNT+FSTLEN
SETZM BLKFRE ;NO FREE SPACE FOR BLOCKS
SETOM BLKTOP ;NOT CURRENTLY ALLOCATING IN ANY BLOCK
POPJ P,
;SWITCH, UNSCAL
MPC,<
%SWITCH:MOVE T,PONPNT
EXCH T,PONPN2
MOVEM T,PONPNT
TLC SID,400000
MOVSS BARLST
POPJ P,
>;MPC
;convert from III points to internal points
;(internal coords are shifted 1 - the low bit is 0)
%UNSCAL:
PUSH P,TT
PUSH P,TTT
MPC,< ASH T,4 > ;Nscale 8 is 1:1
MD,< ASH T,2 > ;Nscale 2 is 1:1
IDIV T,NSCALE
LSH TT,1
MOVM TTT,TT
HLLE TT,TT ;IF NEG, -1
TRO TT,1 ;+1 OR -1
CAML TTT,NSCALE ;GREATER OR EQUAL TO HALF NSCALE?
ADD T,TT ;YES, FUDGE BY ONE IN PROPER DIRECTION
TRZ T,1
POP P,TTT
POP P,TT
POPJ P,
PERRET:
TLNN M,MACACT
OUTSTR[ASCIZ/???
/]
LERRET: PUSHJ P,COMCLR ;IN CASE IN ALTER MODE
TLNE M,MACACT
POPJ P, ;MACRO USERS TAKE THEIR CHANCES
TLC M,DSKACT!DSKFLG
TLCE M,DSKACT!DSKFLG ;BOTH DISK INPUT AND ACTIVE?
POPJ P, ;NO
OUTSTR[ASCIZ/DUE TO ERROR, /]
JRST IBREAK
NODEC,<
%UUOCON:MOVEM T,UUOSAV
DBG,< MOVEM G,UUOG >
LDB T,[POINT 9,UUO,8]
CAIL T,UUO2-UUO1
MOVEI T,0
MOVE T,(T)[
UUO1: BADUUO
PTBYT
PTSTR
DBG,< AFETCH
AFETL
ASTORE
ASTORL
ACLEAR
ARETBL
>;DBG
NODBG,< BADUUO  BADUUO  BADUUO  BADUUO  BADUUO
BADUUO
>;NODBG
III,< LHYADD ;Leahy display - append
LHYIOT ; 0=clr, 7=chrsize pp, 6=ypos
LHYOUT ;output display list
>;III
UUO2: ]
EXCH T,UUOSAV
JRST @UUOSAV
BADUUO: OUTSTR [ASCIZ/ILLEGAL UUO PERFORMED!! /]
HALT CPOPJ
>;NODEC
PTBYT: PUSH P,TTT
HRRZ TTT,UUO
XCT PUTCHR
POP P,TTT
POPJ P,
PTSTR: PUSH P,TTT
PUSH P,T
HRRZ T,UUO
TLOA T,(<POINT 7,0>)
PTSTRL: XCT PUTCHR
ILDB TTT,T
JUMPN TTT,PTSTRL
POP P,T
POP P,TTT
POPJ P,
;DEBUGING CHECKERS
COMMENT 
FETCH, STORES, CLEARS, are turned into UUOs for
debug mode.
.FETCH AC,<"index AC">+<element-index>
The element index points into ELEMxx tables to
define the displacment within the structure and
the fetch code.
The fetch code specifies where element is in word,
and whether sign extension is desired.

DBG,<
STORAGE(IMPURE)
UUOG: 0
UUOTEM: 0
UUOHLT: 0
SUUO: 0
STORAGE(PURE)
AFETCH: MOVEI G,[HLRZ HLRE HRRZ HRRE MOVE]
JRST UUOCOM
AFETL: MOVEI G,[HLLZ HLLE HRLZ HRLE 0]
JRST UUOCOM
ASTORE: HRROI G,[HRLM HRLM HRRM HRRM MOVEM]
JRST UUOCOM
ASTORL: HRROI G,[HLLM HLLM HLRM HLRM 0]
JRST UUOCOM
ACLEAR: HRROI G,[HRRZS HRRZS HLLZS HLLZS SETZM]
UUOCOM: PUSHJ P,PUSHIT ;SAVE ALL THE AC'S
MOVEM A,UUOTEM
MOVE A,UUO
MOVEM A,SUUO
LDB A,[140600,,A] ;"SOURCE" AC FIELD
DPB A,[220400,,UUO] ; TO INDEX
EXCH A,UUOTEM
EXCH G,UUOG
HRRZ F,@UUOTEM ;F = STRUCTURE BLOCK
EXCH G,UUOG ;G = INST TYPE
LDB H,[1400,,UUO] ;THE ELEMENT INDEX
CAIL H,MAXELM
PUSHJ P,FUCKUP
HLRZ A,ELEMTB(H) ;WHERE
ADD G,A
LDB A,[331100,,(G)] ;THE OPCODE
DPB A,[331100,,UUO]
HRRZ A,ELEMTB(H)
HRRM A,UUO
HRRZ G,.JBREL ;LEGAL POINTER INTO LOW CORE?
SKIPLE F
CAMGE F,G
JRST UUAOK
HRRZ G,.JBHRL ;MAYBE POINTER IN HIGH SEG?
CAILE F,400000 ; (CAN'T BE 1ST WORD OF HI SEG EITHER)
CAML F,G
JRST [ TLO F,400000 ;FLAG THAT IT WAS ILLEGAL POINTER
JRST TROUB2]
UUAOK: MOVE A,-1(F) ;THE TYPE OF STRUC WE'RE ADDRESSING
CAME A,ELEMBL(H) ;RIGHT FOR THIS ELEM?
JRST TROUBL
UUOOK: PUSHJ P,POPIT
MOVE G,UUOG
XCT UUO
POPJ P,
TROUBL: PUSHJ P,TRBPNT ;POINT <=> BPOINT INTERCHANGABLE
CAIA
JRST UUOOK
TROUB1: MOVE A,ELEMBL(H) ;Q'S CAN BE USED TO REFERENCE ALMOST ANYTHING
CAMN A,['QOMMON']
JRST UUOOK
;Some fetches may be offset by RADDR(...), so check to
;see if the thing pointed to might be the right type (or null)
MOVSI T,-MAXRDR
TROUB4: CAME H,RADDRT(T) ;IS THIS AN ELEM WHICH COULD BE FUNNY?
AOBJN T,.-1
JUMPGE T,TROUB2
MOVE TT,F
ADD TT,RADRV2(T) ;OFFSET INTO OTHER STRUC
HRRZ TTT,RADRNM(T)
CAIL TTT,MAXELM
JRST [ CAME TT,TTT ;EXACTLY THAT POINTER?
JRST TROUB5
JRST UUOOK]
MOVE TTT,ELEMBL(TTT) ;THE OTHER STRUC'S NAME
CAMN TTT,-1(TT)
JRST UUOOK
TROUB5: AOBJN T,TROUB4
TROUB2: OUTSTR [ASCIZ /
Illegal /]
LDB A,[331100,,SUUO]
OUTSTR @FETNAM-<<.FETCH>-=27>(A)
OUTCHR ["("]
OUTSTR @ELEMNM(H)
OUTSTR [ASCIZ /) of a /]
SKIPG F ;LEGAL POINTER ADDRESS?
JRST [ OUTSTR [ASCIZ /?/]
JRST TROUB3]
MOVE TTT,-1(F)
JSP T,.SIXP
TROUB3: OUTSTR [ASCIZ /...Continue(Y,N,alt)/]
PUSHJ P,YORNTT
JRST ERRET
AOSA UUOHLT
SETZM UUOHLT
PUSHJ P,POPIT
MOVE G,UUOG
SKIPE UUOHLT
HALT .+1
XCT UUO
POPJ P,
TRBPNT: CAME A,['BPOINT'] ;WE CAN REFER TO BPOINTS AS POINTS
POPJ P,
MOVE A,ELEMBL(H)
CAMN A,['POINT ']
AOS (P)
POPJ P,
FETNAM: FOR I IN (.FETCH,.FETL,.STORE,.STORL,.CLEAR)
< [ASCIZ /I/]
>
DEFINE FOOS
< FOO(PNXT,PONPNT)
FOO(BPNXT,PONPNT)
FOO(TNXT,BODPNT)
FOO(BNXT,DBODPN)
FOO(TPNX,,TPIN)
FOO(BPLNK,,BLNK)
FOO(BPBIT,,PBIT) ;CAN REFER TO PBIT'S AS BPBITs
FOO(TCSTR,,TXVAL) ;2ND HALF OF PROP/TEXT BLOCKS CAN LOOK LIKE OFFSET
FOO(TCXY,,TXOFF)
FOO(TCX,,TXOX)
FOO(TCY,,TXOY)
MPC,< FOO(PNXT,PONPN2)
FOO(BPNXT,PONPN2)
>
MD,< FOO(GNXT,GETLST)
FOO(QNXT,,TLIN)
FOO(TPNX,PINS)
FOO(DPNXT,,DDNXT)
FOO(TXNXT,,BTXT)
FOO(TXNXT,BTEXT)
FOO(TLIB,,SLIB) ;SHORT FORM OF TYPE
FOO(TNAM,,SNAM)
FOO(TYP1,,SYP1)
FOO(TNXT,,SNXT)
>;MD
REPEAT 10,<-1 ;ROOM FOR SOME PATCHES
>
>
DEFINE FOO $ (ELEM,POINTER,ELEM2)
< U.$ELEM
>
RADDRT: FOOS
MAXRDR__.-RADDRT
DEFINE FOO $ (ELEM,POINTER,ELEM2)
< V.$ELEM-IFDIF<ELEM2><><V.$ELEM2;>0
>
RADRV2: FOOS
DEFINE FOO $ (ELEM,POINTER,ELEM2)
< IFDIF <POINTER><><POINTER;>U.$ELEM2
>
RADRNM: FOOS
ARETBL: PUSHJ P,PUSHIT
MOVEM A,UUOTEM
LDB A,[270400,,UUO]
EXCH A,UUOTEM
HRRZ F,@UUOTEM ;POINTER TO BLOCK
HRRZ H,UUO ;BLOCK TYPE#
GETREL G
SKIPLE F
CAML F,G
JRST ARETB1
MOVE A,-1(F)
CAMN A,SURNAM(H) ;RETURNING WHAT WE CLAIM?
JRST ARETOK
MOVSI T,-MAXSUR ;NO, BUT MAYBE SAME LENGTH BLK
CAME A,SURNAM(T) ; (THIS COVERS VARIOUS CASES THAT WEREN'T FIXED)
AOBJN T,.-1
JUMPGE T,ARETB1
HRRZ A,SURLEN(T)
CAMN A,SURLEN(H)
JRST ARETOK
ARETB1: OUTSTR [ASCIZ /
Illegal return of /]
SKIPLE
CAML F,G
SKIPA TTT,['?']
MOVE TTT,-1(F)
JSP T,.SIXP
OUTSTR [ASCIZ / as /]
MOVE TTT,SURNAM(H)
JSP T,.SIXP
OUTSTR [ASCIZ /...Continue(Y,N,alt)/]
PUSHJ P,YORNTT
JRST ERRET
HALT .+1
ARETOK: HRRZ A,SURLEN(H)
MOVEI F,-1(F)
EXCH F,BLKPNT+1(A) ;1 WD EXTRA FOR SUR'S NAME
HRRZM F,@BLKPNT+1(A)
PUSHJ P,POPIT
POPJ P,
>;DBG
;TXTMAT, SIGMAT, SIGMAA
;TXTMAT - MATCH TEXT STRINGS (TEXSTR) A,B
TXTMAT: MOVE T,1(B) ;GET NEXT WORD OF TEXT
CAME T,1(A) ;COMPARE IT WITH OTHER STRING
POPJ P, ;DIFFERENT, NO MATCH
HRRZ A,(A) ;GO TO NEXT WORD
HRRZ B,(B) ;...
JUMPE A,[JUMPN B,CPOPJ ;IF A ENDS AND B DOESN'T, NO MATCH
AOS(P) ;IF BOTH END, MATCH
POPJ P,]
JUMPN B,TXTMAT ;IF NEITHER ENDS, LOOP
POPJ P, ;IF B ENDS AND A DOESN'T, NO MATCH
;TXTCMP - ALPHA COMPARE FOR GREATER,LESS
;A,B - STRINGS IN TEXSTR FORMAT
;SKIPS A .GE. B
TXTCMP: LDB T,[POINT 35,1(A),34] ;FLUSH LOW BIT, AND NO SIGN BIT FOR COMPARE
LDB TT,[POINT 35,1(B),34]
CAMGE T,TT ;A .GE. B?
POPJ P, ;NO
CAME T,TT
JRST CPOPJ1 ;A .GT. B
HRRZ A,(A) ;GO TO NEXT WORD
HRRZ B,(B) ;...
JUMPE A,[JUMPN B,CPOPJ ;IF A ENDS AND B DOESN'T, A IS .LT.
JRST CPOPJ1] ;IF BOTH END, A .EQ. B
JUMPN B,TXTCMP ;IF NEITHER ENDS, LOOP
JRST CPOPJ1 ;B ENDS AND A DOESN'T, A .GT. B
IFN 0,<
NODEC,<
SIGMAT: ADD A,[POINT 7,1]
ADD B,[POINT 7,1]
LDB T,[POINT 14,(A),13]
CAIE T,""
CAIN T,""
SUB A,[160000,,0]
LDB T,[POINT 14,(B),13]
CAIE T,""
CAIN T,""
SUB B,[160000,,0]
PUSHJ P,GETITA
JRST CKENDB
CAIN T,""
MOVEI T,""
MOVE TT,T
PUSHJ P,GETITB
POPJ P,
CAIN T,""
MOVEI T,""
JRST SIGMA2
SIGMA1: PUSHJ P,GETITA
JRST [CKENDB:PUSHJ P,GETITB
AOS (P) ;ENDS ALSO, MATCH
POPJ P,]
MOVE TT,T
PUSHJ P,GETITB
POPJ P, ;A DIDN'T END, NO MATCH
SIGMA2: CAME T,TT
POPJ P,
JRST SIGMA1
>;NODEC
GETITA: TLNN A,760000
JRST [ HRR A,-1(A)
TRNN A,-1
POPJ P,
JRST .+1]
ILDB T,A
JUMPE T,GETITA
NODEC,< TRNE M,SPACES ;ARE SPACES SIGNIFICANT?
JRST SIGCHR ;YES
CAIE T,DBLARR
CAIN T," "
JRST GETITA
JRST SIGCHR
GETITB: TLNN B,760000
JRST [ HRR B,-1(B)
TRNN B,-1
POPJ P,
JRST .+1]
ILDB T,B
JUMPE T,GETITB
TRNE M,SPACES
JRST SIGCHR
CAIE T," "
CAIN T,DBLARR
JRST GETITB
SIGCHR:
>;NODEC
DEC,< CAIN T,11 ;FLUSH TABS
JRST GETITA
>;DEC
CAIL T,"a" ;CONVERT LOWER CASE TO UPPER CASE
CAILE T,"z"
CAIA
SUBI T,40
CAIE T,";" ;THIS IS THE COMMENT CHAR
AOS (P)
POPJ P,
>;IFN 0
;COMPARE SIGNAMES FOR EQV
;A = BYTE POINTER TO FIRST WORD OF STRING (TEXSTR TYPE)
;B = POINTER TO ASCIZ
SIGMAT: SETZM VARLST ;NO VARS
PUSH P,D
PUSH P,C
PUSH P,B
PUSHJ P,PERMUT
POP P,TT
POP P,C
POP P,D
MOVEI T,CMPWRD
PUSHJ P,ALPHA
POPJ P,
POPJ P,
JRST CPOPJ1
JRST CPOPJ1
JRST CPOPJ2
;CHANGE ONE SIGNAL NAME TO ANOTHER PERVASIVELY
MD,<
SIGCHG: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/OLD SIGNAL NAME?
/]
PUSHJ P,TREADC
POPJ P, ;ALTMODE
POPJ P, ;NULL
PUSH P,B
MOVE A,B
ADD A,[POINT 7,1]
PUSHJ P,SIGMAA ;PERPARE OLD NAME FOR SEARCHING
POP P,B
PUSHJ P,PUTFS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NEW SIGNAL NAME?
/]
PUSHJ P,TREADC
POPJ P,
POPJ P,
MOVEM B,DX1
SKIPE E,PONPNT
PUSHJ P,ACLRP ;CLEAR ALL THE "FOUNDP" BITS
SETZM FIND
MOVSI C,17
SKIPE A,PONPNT
PUSHJ P,CLRBTS ;CLEAR MARK BITS
SKIPE H,PONPNT
PUSHJ P,SIGCDO
MOVE T,FIND
MOVEM T,FNDNUM ;STORE FOR MACRO CALL AT ;R
JUMPE T,.+2
SETOM FIND
SKIPN T,FNDNUM
JRST [ OUTSTR[ASCIZ/NO/]
JRST SIGCHF]
PUSHJ P,DECOUT
SIGCHF: OUTSTR[ASCIZ/ SIGNAL NAME/]
MOVE T,FNDNUM
CAIE T,1
OUTCHR["S"]
OUTSTR[ASCIZ/ CHANGED.
/]
MOVE B,DX1
JRST PUTFS
;SIGCDO: CALLING SEQUENCE
; <STRING TO FIND IN A>
; ADD A,[POINT 7,1]
; PUSHJ P,SIGMAA
; <NEW SIG IN DX1>
; SKIPE H,PONPNT
; PUSHJ P,SIGCDO
; <RETURNS HERE ALWAYS>
; <FIND AOS'D ONCE FOR EACH SIGNAL CHANGED>
SIGCDO: FETCHL(T,H,PBIT)
TLNE T,1
JRST SIGCH2 ;ALREADY DONE
FETCH(G,H,PTXT)
JUMPE G,SIGCH2
FETCH(A,G,TCSTR)
ADD A,[POINT 7,1]
MOVEI B,SIGTAB
PUSHJ P,SIGMAT
JRST SIGCH2 ;NO MATCH
JFCL ;EQUIVALENT IS OK
AOS FIND
SETBIT(FOUNDP!1,T,H,PBIT)
FETCH(A,G,TCSTR)
ADD A,[POINT 7,1]
PUSHJ P,PERME1 ;EXTRACT LEADING STUFF
MOVE T,POLAR ;GET OLD POLARITY
MOVEM T,OPOLAR ;AND SAVE HERE FOR PERMES
PUSH P,PUTCHR
PUSHJ P,SETTT7
PUSH P,A
PUSHJ P,SIGCHX ;Copy leading stuff into new string
MOVE A,DX1
ADD A,[POINT 7,1]
PUSHJ P,PERMES ;EXTRACT NEW SIGNAL NAME (POSSIBLY CHANGING POLARITY)
PUSHJ P,SIGCHX
FETCH(A,G,TCSTR)
ADD A,[POINT 7,1]
PUSHJ P,PERME2 ;NOW GET TRAILER
PUSHJ P,SIGCHX
FETCH(B,G,TCSTR)
FETCH(TT,B,TSSIZ)
PUSHJ P,PUTFS
POP P,A
STORE(TT,A,TSSIZ)
STORE(A,G,TCSTR)
POP P,PUTCHR
TRO MCHG
SKIPE ADDR(A,TSASC)
JRST SIGCH6
MOVE A,H
PUSHJ P,PTKIL1 ;FLUSH NULL TEXT
JRST SIGCH2
SIGCH6: MOVE A,H
PUSHJ P,FIXEM
SIGCH2: HRRZ H,(H)
JUMPN H,SIGCDO
POPJ P,
SIGCHX: SKIPA A,[POINT 7,ESGTAB]
SIGCHY: PUTBYT (C)
ILDB C,A
JUMPN C,SIGCHY
POPJ P,
>;MD
;PUTFS
PUTFS: JUMPE B,CPOPJ
PUSH P,T
PUTFS1: HRRZ T,(B) ;GET LINK TO NEXT
FSTRET (B)
JUMPE T,POPTJ
HRRZ B,(T)
FSTRET (T)
JUMPN B,PUTFS1 ;IF NON-ZERO LINK, LOOP
POPTJ: POP P,T
POPJ P,
;READ NUMBER INTO T
SREADN: MOVEI T,0
PUSHJ P,GETLIN
CAIE C,"-"
JRST RNLOP1
PUSHJ P,READN
MOVN T,T ;GIVE HIM NEGATIVE
POPJ P,
;TO BE CALLED TO SCAN A SINGLE NUMBER WHICH SHOULD
;END WITH LF, CALL ONLY AT TOP LEVEL (WILL POP POPJ ON ERROR)
READNC: PUSHJ P,READN
CAIN C,12
POPJ P,
POP P,(P) ;LOSE THE RETURN
JRST INNERR ;AND JUMP TO INPUT ERROR ROUTINE
CREADN: SETZ T,
JRST RNLOP1
READN: MOVEI T,
RNLOP: PUSHJ P,GETLIN ;GET A CHR.
RNLOP1: PUSH P,[=10]
CAIE C,"'"
JRST RNLOP3
MOVEI C,10
MOVEM C,(P)
RNLOP2: PUSHJ P,GETLIN
RNLOP3: CAIL C,"0" ;IS IT A DIGIT?
CAILE C,"9" ;???
JRST [ POP P,(P);NO
POPJ P,]
IMUL T,(P) ;YES, MULT BY PROPER AMOUNT
ADDI T,-60(C) ;ADD IN NEW THING
AOS NDIG ;COUNT A DIGIT
JRST RNLOP2
;READ TEXT STRING, LOOK FOR SIZE SPEC
;RETURNS
;B = TEXT STRING
;T,TEXSIZ = TEXT SIZE (-1 IF NONE)
;TT,TEXLIN = #LINES,,MAX LINE LENGTH
TXREAD: GETBLK(B,TEXSTR)
PUSH P,B ;SAVE POINTER TO BEGINNING OF STRING
CLEAR(B,TSASC) ;CLEAR BYTE WORD
ADD B,[POINT 7,1]
SETZB TT,TTT ;ZERO COUNTERS
MOVNI T,1 ;FLAG NO SIZE TYPED YET
PUSHJ P,GETLIN ;GET FIRST CHR.
ANDI C,177
CAIE C,"\" ;\?
JRST BLOPP ;NO
PUSHJ P,READSZ ;GET SIZE STUFF INTO T
CAIA
JRST BLOP
MOVNI T,1 ;ERROR, FLAG AS IF NONE TYPED
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/ILLEGAL TEXT SIZE, WILL MAKE BELIEVE NONE WAS TYPED.
/]
BLOP: PUSHJ P,GETLIN ;GET NEXT CHR OF NAME
ANDI C,177
BLOPP: CAIE C,ALTMOD ;QUIT ON ALTMODE ALSO
CAIN C,12 ;DONE (LINE FEED)
JRST BDON
CAIE C,DBLARR ;END OF LINE?
AOJA TTT,BLOPCR ;NO, COUNT CHAR
ADD TT,[1,,0] ;COUNT ANOTHER LINE
CAILE TTT,(TT) ;THIS LINE LONGEST SO FAR?
HRR TT,TTT ;YES
SETZ TTT, ;RESET LINE LENGTH COUNT
BLOPCR: TLNE B,760000 ;END OF WORD?
JRST BPNT1
GETBLK(D,TEXSTR)
CLEAR(D,TSASC)
HRRZM D,-1(B)
HRR B,D
BPNT1: IDPB C,B
JRST BLOP
BDON: CAILE TTT,(TT) ;LAST LINE LONGEST?
HRR TT,TTT ;YES
MOVEM T,TEXSIZ
MOVEM TT,TEXLIN
SETZM -1(B) ;CLEAR LAST POINTER
POP P,B ;GET POINTER TO FRONT OF STRING
POPJ P,
;READSZ - GET INITIAL SIZE SPEC ON TEXT INPUT
READSZ: PUSHJ P,GETLIN ;YES, GET SIZE
ANDI C,177
SETZ T, ;ASSUME HORIZONTAL
CAIE C,"V" ;IS HE ASKING FOR VERTICAL?
JRST NOVERT ;NO
PUSHJ P,GETLIN
ANDI C,177
MOVEI T,400000 ;MARK AS VERTICAL
NOVERT: SUBI C,60 ;NORMALIZE NUMBER
JUMPL C,CPOPJ ;TOO SMALL?
IOR T,C ;MAKE SIZE
CAIG C,CSIZES ;OR TOO BIG?
AOS (P)
POPJ P, ;ERROR RETURN
;READ TEXT
;B = POINTER TO TEXT
;TREADU,TREADC
;RETURN
; 1 $ TYPED
; 2 NULL INPUT
; 3 OK
;TREADU,TREADV CONVERT TO UPPER CASE
TREADU: PUSHJ P,TREADV
CAIA
TREADC: PUSHJ P,TREAD
CAIN C,ALTMOD ;END WITH ALTMODE?
JRST PUTFS ;YES, GIVE BACK STRING AND DIRECT RETURN
AOS (P) ;AT LEAST ONE SKIP
SKIPE 1(B) ;NULL?
AOSA (P) ;NO, ANOTHER SKIP
JRST PUTFS ;YES, GIVE IT BACK
POPJ P,
TREADV: SETOM LOW2UP
CAIA
TREAD: SETZM LOW2UP
GETBLK(B,TEXSTR)
CLEAR(B,TSASC)
PUSH P,B
ADD B,[POINT 7,1]
TREADA: PUSHJ P,GETLIN
CAIE C,ALTMOD
CAIN C,12
JRST TREDON
TLNE B,760000
JRST TREADG
GETBLK(T,TEXSTR)
CLEAR(T,TSASC)
HRRZM T,-1(B)
HRR B,T
TREADG: SKIPN LOW2UP
JRST TREADL
CAIL C,"A"+40
CAILE C,"Z"+40
CAIA
SUBI C,40
TREADL: IDPB C,B
JRST TREADA
TREDON: SETZM -1(B) ;CLEAR LAST POINTER
POP P,B ;GET POINTER TO FRONT OF STRING
POPJ P,
SCARF: CAIN C,12
AOSA (P)
CAIN C,ALTMOD
POPJ P,
PUSHJ P,GETLIN
JRST SCARF
INNERR: PUSHJ P,SCARF
JRST LERRET
OUTSTR[ASCIZ/INPUT ERROR!
/]
JRST LERRET
;LOOKUP A SIGNAL IN WIRLST, AND FLASH IT!
XFLASH: SKIPN B,BLPNTR
POPJ P,
PUSHJ P,PUTFS
SETZM BLPNTR
IFN UMLSW!LAYSW,<
MPC,< SETZM UPINS >
>;IFN UMLSW!LAYSW
TRO MCHG
POPJ P,
NOUML,<
LOKSIG: JRST PERRET
>;NOUML
UML,<
LOOKN: SKIPN A,WIRLST
JRST NOWIRL
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/WIRE NUMBER FROM WFAIL.DAT FILE?/]
PUSHJ P,READNC
MOVE C,A
SETZM DX1
LOOKN0: AOS DX1
SOJLE T,LOOKN1
HRRZ C,(C)
JUMPN C,LOOKN0
OUTSTR[ASCIZ/NO SUCH WIRE!
/]
POPJ P,
LOKSIG: SKIPN WIRLST
JRST [NOWIRL: OUTSTR[ASCIZ/NO WIRES IN WIRLST!
/]
POPJ P,]
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/SIGNAL NAME TO LOOKUP?/]
PUSHJ P,TREADC
POPJ P, ;ALTMODE
POPJ P, ;NULL
PUSH P,B ;SAVE POINTER TO ORIG STRING
MOVE A,B
ADD A,[POINT 7,1]
PUSHJ P,SIGMAA ;MAKE COMPARE STRING
POP P,B
PUSHJ P,PUTFS ;GIVE BACK TYPED IN VERSION
PUSHJ P,LOOKIT ;LOOK IT UP
JRST LOKSGN ;NONE
LOOKN1: HRRZ B,1(C) ;GET WIRE POINTER
PUSHJ P,LSTSGO ;PRINT ALL THE NAMES
PUSH P,C
PUSHJ P,LINKST
POP P,C
HRRZ C,1(C) ;POINTER TO LIST OF PINS, ETC
POKSG1:
MPC,< HRRZ A,1(C) ;WILD CON STUFF IS HERE
ADDM A,UPINS
>;MPC
HLRZ A,(C) ;PIN POINTER
JUMPE A,POKSG2
PUSH P,C
PUSHJ P,LINKIT
POP P,C
POKSG2: HRRZ C,(C)
JUMPN C,POKSG1
PUSHJ P,LINKMK ;NOW MARK BAD GUYS
TRO MCHG ;GET IT ON
TLNN M,LCENTER
POPJ P,
JRST LCENMAK ;CENTER IT!
LOOKIT: MOVE C,WIRLST ;LOOK DOWN THE LIST
SETZM DX1
LOKSG3: HRRZ D,1(C)
AOS DX1
LOKSG1: HLRZ A,1(D)
JUMPE A,LOKSG2
ADD A,[POINT 7,1]
MOVEI B,SIGTAB
PUSHJ P,SIGMAT
JRST LOKSG2 ;NO MATCH
JFCL ;EQUIVALENT IS CLOSE ENOUGH
AOS (P)
POPJ P,
LOKSG2: HRRZ D,(D)
JUMPN D,LOKSG1
HRRZ C,(C)
JUMPN C,LOKSG3
POPJ P,
LOKSGN: OUTSTR[ASCIZ/NOT FOUND!
/]
POPJ P,
LSTSIG: SKIPN A,WIRLST
JRST NOWIRL
SETZM DX1
LSTSG1: HRRZ B,1(A)
AOS DX1
PUSHJ P,LSTSGO
HRRZ A,(A)
JUMPN A,LSTSG1
POPJ P,
;CALL (LSTSGO) WITH SINGLE WIRE POINTER IN B, AND DX1 = SIGNAL #
LSTSGO: MOVE T,DX1
PUSHJ P,DECOUT
LSTSG6: HLRZ T,1(B)
JUMPE T,LSTSG3
OUTCHR[11]
PUSHJ P,OUTTXT
LSTSG3: HRRZ B,(B)
JUMPN B,LSTSG6
MPC,< HRRZ T,1(A)
HRRZ T,1(T)
JUMPE T,LSTSG4
OUTCHR[11]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ "WILD"/]
LSTSG4:
>;MPC
OUTSTR[ASCIZ/
/]
POPJ P,
MD,<
SHWERR: SOSL TT,%LAST ;COUNT DOWN AND PICKUP LAST GEN NAME
SKIPN C,WIRLST ;ANY WIRES?
JRST PERRET ;NO MORE
SOJL TT,LOOKN1
HRRZ C,(C)
JUMPN C,.-2
JRST SHWERR
>;MD
>;UML
;CURSOR MOVING
DEFINE MOV $ (SHFT,MOVT,ADDT)
< MOVSI TT,1
LSH TT,SHFT(A)
MPC,< IMUL TT,STPSIZ>
MOV$MOVT T,CURSE
ADDT T,TT
MOV$MOVT$M T,T
JRST SETPOS
>
MOVUP1: MOV (1,S,ADD)
MOVDN1: MOV (1,S,SUB)
MOVUP2: MOV (5,S,ADD)
MOVDN2: MOV (5,S,SUB)
MOVLF1:
MPC,< TRNE M,FLIP
JRST MOVRT3
>;MPC
MOVLF3: MOV (1,E,SUB)
MOVRT1:
MPC,< TRNE M,FLIP
JRST MOVLF3
>;MPC
MOVRT3: MOV (1,E,ADD)
MOVLF2:
MPC,< TRNE M,FLIP
JRST MOVRT4
>;MPC
MOVLF4: MOV (5,E,SUB)
MOVRT2:
MPC,< TRNE M,FLIP
JRST MOVLF4
>;MPC
MOVRT4: MOV (5,E,ADD)
;SET AND CLEAR FLAGS
STBOOP: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NUMBER OF SECONDS BEFORE BOOP?/]
PUSHJ P,READN
CAIE C,12
JRST INNERR
MOVEM T,BOOPCN
TIMER T,
MOVEM T,BOOPLR
POPJ P,
CLBOOP: SETZM BOOPCN
POPJ P,
MD,<
;SOCKET - FORCE PIN'S ON DRAWINGS TO BE ACTUAL SOCKET PINS, NOT BODY
STSOC: SETOM FORSOC
tro mchg
POPJ P,
CLRSOC: SETZM FORSOC
tro mchg
POPJ P,
>;MD
DEC,<
STTIME:
GT,< MOVE T,NBYTES
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ BYTES TRANSMITTED TO GT40 (/]
SKIPN OPTFLG
OUTSTR[ASCIZ/NON-/]
OUTSTR[ASCIZ/OPTIMIZED)
/]
>;GT
MOVE A,RTIME ;SAVE LAST RUNTIME
MOVE B,QTIME ;AND LAST RUN QUEUE TIME
MOVE C,DTIME ;AND LAST REAL TIME
PUSHJ P,CLTIME ;UPDATE CELLS
OUTSTR[ASCIZ/RTIME = /]
SUB A,RTIME
MOVN T,A
PUSHJ P,SECPNT ;PRINT SECONDS WITH 3 DECIMAL POINTS
OUTSTR[ASCIZ/, QTIME = /]
SUB B,QTIME
CAMLE B,A
MOVE B,A ;MAKE SURE QTIME.GE.RTIME (NEG)
MOVN T,B
PUSHJ P,SECPNT
OUTSTR[ASCIZ/, /]
IMULI A,=100
IDIV A,B
MOVE T,A ;THIS IS PERCENTAGE SERVICE
PUSHJ P,DECOUT
OUTSTR[ASCIZ/%
REALTIME = /]
SUB C,DTIME
MUL C,[-=24*=60*=60*=60] ;MAKE IT POSITIVE AND TICS
LSHC C,=18
MOVE T,C
PUSHJ P,SECPNT
OUTSTR[ASCIZ/
/]
POPJ P,
CLTIME: MOVE T,[-1,,4]
GETTAB T, ;GET RUNTIME
SETZ T,
MOVEM T,RTIME
MOVE T,[-1,,53] ;GET RUN QUEUE TIME
GETTAB T,
SETZ T,
MOVEM T,QTIME
MOVE T,[53,,11]
GETTAB T, ;GET UNIVERSAL DAY TIME
SETZ T,
MOVEM T,DTIME
GT,< SETZM NBYTES >
POPJ P,
SECPNT: IDIVI T,=60
HRLM TT,(P)
PUSHJ P,DECOUT
OUTCHR["."]
HLRZ T,(P)
IMULI T,=10
IDIVI T,=6 ;MAKE IT HUNDREDTHS
CAIGE T,=10
OUTCHR["0"]
JRST DECOUT
>;DEC
STINIT: TLZ NOINIT
POPJ P,
CLINIT: TLO NOINIT
POPJ P,
EXACTS: TROA M,SEXACT
EXACTC: TRZ M,SEXACT
POPJ P,
SETLC: SETOM LCFLAG
POPJ P,
CLRLC: SETZM LCFLAG
POPJ P,
SIDENT: TLON M,%IDENT
TRO MCHG!NEEDCL
POPJ P,
CIDENT: TLZE M,%IDENT
TRO MCHG!NEEDCL
POPJ P,
STLPPN: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/LIBRARY PPN?/]
NOCMU,<
NOITS,< PUSHJ P,GETPPN
JRST INNERR
CAIN C,12
JRST [ HRRZM T,LIBPPN
SETZ T,
DSKPPN T,
HLLM T,LIBPPN
POPJ P,]
CAIE C,","
JRST INNERR
MOVE B,T
PUSHJ P,GETPPN
JRST INNERR
CAIE C,12
JRST INNERR
HRLZM B,LIBPPN
HRRM T,LIBPPN
>;NOITS
>;NOCMU
ITS,< PUSHJ P,GETNAM
JUMPE T,INNERR
CAIE C,12
JRST INNERR
MOVEM T,LIBPPN
>;ITS
CMU,< SETZM PPNBUF ;CLEAR OUT A BUFFER FOR THE PPN
SETZM PPNBUF+1
SETZM PPNBUF+2
MOVE B,[POINT 7,PPNBUF]
MOVEI T,=13 ;13 CHARACTERS AT MOST!
CMUPP7: PUSHJ P,GETLIN ;GET A CHAR
JRST CMUPP9
CAIE C,15 ;IGNORE CR
CAIN C,40 ;AND SPACE
JRST CMUPP7
CAIN C,12 ;LF
JRST CMUPP9 ;YES, THAT'S ALL FOLKS.
CAIE C,"[" ;IGNORE [
CAIN C,"]" ;AND ]
JRST CMUPP7
CAIL C,"a" ;CONVERT LOWER CASE TO UPPER CASE
CAILE C,"z"
JRST .+2
SUBI C,40 ;CONVERT IT
CMUPP8: IDPB C,B
SOJGE T,CMUPP7 ;AND GO GET ANOTHER CHAR UNLES WE HAVE 13+1
JRST INNERR ;FUNNY, WE DIDN'T GET THERE IN 13 CHARACTERS!
CMUPP9: MOVE T,[XWD B,PPNBUF]
CMUDEC T, ;CONVERT THE PPN TO DEC FORMAT
JRST INNERR ;WHOOPS, BAD PPN
MOVEM A,LIBPPN
>;CMU
POPJ P,
CLLPPN:
MOVE T,[DATPPN]
MOVEM T,LIBPPN
POPJ P,
SETSPC: TRO M,SPACES
POPJ P,
CLRSPC: TRZ M,SPACES
POPJ P,
SETCNT: TLO M,LCENTER
JRST LCENMAK
CLRCNT: TLZ M,LCENTER
POPJ P,
SETLCA: TLON LOCATE
TRO NEEDCL
POPJ P,
CLRLCA: TLZE LOCATE
TRO NEEDCL
POPJ P,
NEWID: SETZM BID
SETOM OLDBID
SETZM PID
SETOM OLDPID
JRST REEID ;RE-ASSIGN ID FROM START!
LMACRO: SKIPN A,MDPNT ;GET DEFINED MACRO LIST POINTER
POPJ P,
TVOFF
OUTSTR[ASCIZ/
/]
LMAC1: HRRZ T,1(A)
PUSHJ P,OUTTXT
HLRZ T,(A)
TRNE T,MSAVE ;BEING SAVED?
OUTSTR[ASCIZ/ */];YES
OUTSTR[ASCIZ/
/]
HRRZ A,(A)
JUMPN A,LMAC1
TVON
POPJ P,
GETDDT: SKIPN T,.JBDDT
JRST [ OUTSTR[ASCIZ/NO DDT.....
/]
POPJ P,]
MOVE TT,[10000,,CPOPJ]
MOVEM TT,.JBOPC
JRST (T)
STBLCS: TLON M,BLOCS
TRO MCHG
POPJ P,
CLBLCS: TLZE M,BLOCS
TRO MCHG
POPJ P,
STCLCS: TLON M,CLOCS
TRO MCHG
POPJ P,
CLCLCS: TLZE M,CLOCS
TRO MCHG
POPJ P,
SETPNS: TLON M,PLOCS
TRO MCHG
POPJ P,
CLRPNS: TLZE M,PLOCS
TRO MCHG
POPJ P,
STLINS: TRZE M,NLINES
TRO MCHG
POPJ P,
CLLINS: TRON M,NLINES
TRO MCHG
POPJ P,
MPC,<
STDIPS: TRZE M,NDIPS
TRO MCHG
POPJ P,
CLDIPS: TRON M,NDIPS
TRO MCHG
POPJ P,
STFLIP: TRC M,FLIP ;INVERT X
TRO MCHG
MOVE T,CURSE
JRST SETPOS ;GET CURSOR TO RIGHT PLACE!
STCOMP: TLNE SID,FRONT
POPJ P,
SWSID: TRZ INLIN!INMOV
SWITCH
TRO MCHG!NEEDCL
POPJ P,
STSOLD: TLNN SID,FRONT
POPJ P,
JRST SWSID
STFEED: TRZE M,XFEED
TRO MCHG
POPJ P,
CLFEED: TRON M,XFEED
TRO MCHG
POPJ P,
STFING: TRZE M,XFINGER
TRO MCHG
POPJ P,
CLFING: TRON M,XFINGER
TRO MCHG
POPJ P,
>;MPC
MD,<
SETOUT: SETOM OUTSIDE
POPJ P,
CLROUT: SETZM OUTSIDE
POPJ P,
SETCBX: TRZN M,NOCBOX
POPJ P,
TLNE M,CLOCS
TRO MCHG
POPJ P,
CLRCBX: TROE M,NOCBOX
POPJ P,
TLNE M,CLOCS
TRO MCHG
POPJ P,
SETIDS: TLON M,PINIDS
TRO MCHG
POPJ P,
CLRIDS: TLZE M,PINIDS
TRO MCHG
POPJ P,
SETRID: TLON M,RPINID
TRO MCHG
POPJ P,
CLRRID: TLZE M,RPINID
TRO MCHG
POPJ P,
STUNHI: TLON M,UNHIDE
TRO MCHG
POPJ P,
CLUNHI: TLZE M,UNHIDE
TRO MCHG
POPJ P,
STPTXT: TRZE M,NPTEXT
TRO MCHG
POPJ P,
CLPTXT: TRON M,NPTEXT
TRO MCHG
POPJ P,
STBTXT: TRZE M,NBTEXT
TRO MCHG
POPJ P,
CLBTXT: TRON M,NBTEXT
TRO MCHG
POPJ P,
STMLIB: SETOM MODLIB
POPJ P,
CLMLIB: SETZM MODLIB
POPJ P,
UREST: SKIPN A,PONPNT
POPJ P,
UREST1: MOVE T,ADDR(A,PBIT)
TLNE T,CPIN
TRNN T,-1 ;ANY BACKUP PIN NAME?
JRST UREST2
FETCH(C,A,PLOC)
MOVE TT,(C)
HRRM T,(C) ;BACKUP PIN NAME  PIN LOC
STORE(TT,A,PIN) ;EXCHANGE PIN NAMES
TRO MCHG
PUSHJ P,OFFCON ;FIX CON OFFSET
UREST2: HRRZ A,(A)
JUMPN A,UREST1
POPJ P,
>;MD
SETTXT: TRZE M,MD,<NBTEXT!>NPTEXT
TRO MCHG
TLON M,CLOCS
TRO MCHG
POPJ P,
CLRTXT: TRO M,MD,<NBTEXT!>NPTEXT
TLZ M,CLOCS
TRO MCHG
POPJ P,
SETWIN: TLZN M,XWINDOW
POPJ P,
JRST DOWIN
CLRWIN: TLOE M,XWINDOW
POPJ P,
DOWIN: MOVE T,CURSE
JRST SETPOS
SETLWN: TLON M,LWINDOW
TRO MCHG
POPJ P,
CLRLWN: TLZE M,LWINDOW
TRO MCHG
POPJ P,
SETDPY:
NOCMU,< SKIPE ISDPY >
CMU,< SKIPLE DONTDPY >
POPJ P,
SETZM DONTDPY
DLX,< SETOM DLXFLG > ;IF USER DOESN'T SPECIFY, TRY DL10
JRST DTRY
CLRDPY:
NOCMU,< SKIPE DONTDPY >
CMU,< SKIPGE DONTDPY >
POPJ P,
SETOM DONTDPY
SKIPE ISDPY
PUSHJ P,DPYREL
JRST DSPSET
NODEC,<
DPYREL: DPYCLR
CMU,< RELEASE ATYO, >
SETZM ISDPY
POPJ P,
>;NODEC
GT,<
SETOPT: SKIPE OPTFLG
SKIPN ISDPY
CAIA
POPJ P,
DLX,< SKIPN ISDPY ;IF NOT CURRENTLY DISPLAY,
SETOM DLXFLG ;THEN TRY DL10 FIRST
>;DLX
PUSHJ P,CLRDPY ;LET GO OF DISPLAY
SETZM DONTDPY
SETOM OPTFLG ;THEN TELL IT TO OPTIMIZE
JRST DTRY
CLROPT: SKIPN OPTFLG
SKIPN ISDPY
CAIA
POPJ P,
DLX,< SKIPN ISDPY ;IF NOT CURRENTLY DISPLAY,
SETOM DLXFLG ;THEN TRY DL10 FIRST
>;DLX
PUSHJ P,CLRDPY
SETZM DONTDPY
SETZM OPTFLG
JRST DTRY ;TRY DISPLAY IN CURRENT MODE
DLX,<
SETDLX: SKIPE DLXFLG
SKIPN ISDPY
CAIA
POPJ P,
PUSHJ P,CLRDPY
SETZM DONTDPY
SETOM DLXFLG
JRST DTRY
CLRDLX: SKIPN DLXFLG
SKIPN ISDPY
CAIA
POPJ P,
PUSHJ P,CLRDPY
SETZM DONTDPY
SETZM DLXFLG
JRST DTRY
>;DLX
>;GT
;TITLES, MUNGER, INNER, DIAMONDS
;ROUTINE TO PUT FILENAME INTO MACRO
CLRSIG: PUSHJ P,SETTT
SKIPN TT,(B)
JRST ITSTUF
PUSHJ P,STFSIX
PUTBYT "."
HLLZ TT,1(B)
PUSHJ P,STFSIX
PUTBYT "["
HLLZ TT,3(B)
PUSHJ P,STFPPN
PUTBYT ","
HRLZ TT,3(B)
PUSHJ P,STFPPN
PUTBYT "]"
JRST ITSTUF
STFPPN:
IFN IIISW!DECSW,< HLRZ T,TT
STFPP1: IDIVI T,10
HRLM TT,(P)
JUMPE T,.+2
PUSHJ P,STFPP1
HLRZ T,(P)
PUTBYT 60(T)
POPJ P,
>;IFN IIISW!DECSW
STFSIX: JUMPE TT,CPOPJ
SETZ T,
LSHC T,6
PUTBYT 40(T)
JRST STFSIX
MD,<
CTITLE: MOVE B,TIT1
PUSHJ P,STUFT1
PUTBYT 12
MOVE B,TIT2
PUSHJ P,STUFT2
JRST ITSTUF
STITLE: TLNE M,DSKACT!MACACT
JRST STITL1
SKIPE T,TIT1
PUSHJ P,OUTTCR
SKIPE T,TIT2
PUSHJ P,OUTTCR
OUTSTR[ASCIZ/NEW TITLE LINE 1?/]
STITL1: PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>) ;DON'T CHANGE IF HE TYPE THERE EXISTS
EXCH B,TIT1
JUMPE B,.+2
PUSHJ P,PUTFS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NEW TITLE LINE 2?/]
PUSHJ P,TREADC
JRST TITCHK ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>)
EXCH B,TIT2
JUMPE B,.+2
PUSHJ P,PUTFS
TITCHK:
NOITS,< MOVEI T,=31 > ;MAX LENGTH FOR BOTH STRINGS
ITS,< MOVEI T,=50 > ;APPROX 50 CHARS TOTAL ON XGP
MOVE B,TIT1
PUSHJ P,LENCHK
MOVE B,TIT2 ;REDUCED COUNT STILL IN T
PUSHJ P,LENCHK
POPJ P,
CSITE: MOVE B,SITE1
PUSHJ P,STUFT1
PUTBYT 12
MOVE B,SITE2
PUSHJ P,STUFT2
JRST ITSTUF
SITE: TLNE M,DSKACT!MACACT
JRST SITE0
SKIPE T,SITE1
PUSHJ P,OUTTCR
SKIPE T,SITE2
PUSHJ P,OUTTCR
OUTSTR[ASCIZ/NEW SITE LINE 1?/]
SITE0: PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>) ;DON'T CHANGE IF HE TYPE THERE EXISTS
EXCH B,SITE1
JUMPE B,.+2
PUSHJ P,PUTFS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NEW SITE LINE 2?/]
PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>)
EXCH B,SITE2
JUMPN B,PUTFS
POPJ P,
DEFINE TITLIN $ (LABEL,CLABEL,TPTR,PROMPT,MAXLEN,CHANGE)
<
CLABEL: MOVE B,TPTR
JRST STUFT0
LABEL: TLNE M,DSKACT!MACACT
JRST .$LABEL
SKIPE T,TPTR
PUSHJ P,OUTTCR
OUTSTR[ASCIZ/NEW PROMPT?/]
.$LABEL:
PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
IFDIF<MAXLEN><><
MOVEI T,MAXLEN
PUSHJ P,LENCHK ;CHECK LENGTH AND PRINT WARNING MESSAGE
>
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>) ;THIS SHOULD ALWAYS WORK
EXCH B,TPTR
IFIDN<CHANGE><C><TRO MCHG>
JUMPN B,PUTFS
POPJ P,
>
LENCHK: JUMPE B,CPOPJ
PUSH P,T
MOVE T,B
ADD T,[POINT 7,1]
LENCK1: TLNE T,760000
JRST LENCK2
HRR T,-1(T)
TRNN T,-1
JRST LENCK3 ;END BEFORE COUNT OUT
LENCK2: ILDB TT,T
JUMPE TT,LENCK1
SOS (P) ;COUNT DOWN BY ONE
JRST LENCK1 ;LOOP IF NOT COUNTED OUT
LENCK3: SKIPL (P) ;OVERFLOWED?
JRST LENCK4
OUTSTR[ASCIZ/STRING /]
MOVN T,(P)
PUSHJ P,DECOUT
OUTSTR[ASCIZ/. CHARS TOO LONG, WILL STORE STRING ANYWAY.
/]
LENCK4: POP P,T ;RETURN REDUCED COUNT
POPJ P,
TITLIN(AUTHOR,CAUTHOR,TAUTHOR,AUTHOR)
TITLIN(REVISE,CREVISE,TREV,REVISION,4,C)
TITLIN(MODULE,CMODULE,TMODULE,MODULE NAME,5,C)
TITLIN(VARIABLE,CVARIABLE,TVARIABLE,VARIABLE,2,C)
TITLIN(PREFIX,CPREFIX,TPREFIX,DRAWING PREFIX,4,C)
CLRNUM: MOVE B,TMODULE
PUSHJ P,STUFT1
PUTBYT 12
PUSHJ P,STUFT2
PUTBYT 12
PUSHJ P,STUFT2
JRST ITSTUF
SETNUM: PUSHJ P,MODULE
PUSHJ P,VARIABLE
JRST PREFIX
TITLIN(PROJECT,CPROJECT,TPROJ,PROJECT NAME,10)
CPAGEOF:
MOVE B,TPAGE
PUSHJ P,STUFT1
PUTBYT 12
MOVE B,TOF
PUSHJ P,STUFT2
JRST ITSTUF
PAGEOF: TLNE M,DSKACT!MACACT
JRST PAGOF0
SKIPE T,TPAGE
PUSHJ P,OUTTCR
SKIPE T,TOF
PUSHJ P,OUTTCR
OUTSTR[ASCIZ/SHEET?/]
PAGOF0: PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>) ;DON'T CHANGE IF HE TYPE THERE EXISTS
EXCH B,TPAGE
JUMPE B,.+2
PUSHJ P,PUTFS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/OF?/]
PUSHJ P,TREADC
POPJ P, ;ALTMODE
SETZ B, ;NULL
SKIPE T,B
MOVS T,1(B)
CAIE T,(<BYTE(7)TEXIST>)
EXCH B,TOF
JUMPN B,PUTFS
POPJ P,
TITLIN(DCODE,CDCODE,TDCODE,DRAWING CODE,2)
DEC,<
TITLIN(SETNXT,CLRNXT,TNXTHI,NEXT HIGHER ASSEMBLY NUMBER,=20)
CLRDRN: MOVEI B,DRNNAM
JRST CLRSIG
CLRENG: MOVEI B,ENGNAM
JRST CLRSIG
SETDRN: MOVEI A,DRNNAM
MOVEI T,[ASCIZ/DRN./]
JRST SETSIG
SETENG: MOVEI A,ENGNAM
MOVEI T,[ASCIZ/ENG./]
SETSIG: TLNE M,DSKACT!MACACT
JRST SETSG1
PUSH P,T
SKIPE (A)
JSR FPRINT
OUTSTR[ASCIZ/
NEW /]
POP P,T
OUTSTR(T)
OUTSTR[ASCIZ/ SIGNATURE /]
SETSG1: PUSH P,A
MOVSI T,EXTSIG
PUSHJ P,SETNAM
JRST [ POP P,A
SETZM (A)
POPJ P,]
INIT DAT,17
'DSK '
0
JRST [ OUTSTR[ASCIZ/CAN'T GET DISK!
/]
POP P,A
POPJ P,]
MOVEI A,FILNAM
TLNE M,DSKACT!MACACT
JRST SETSG2
OUTSTR[ASCIZ/CHECKING EXISTENCE OF /]
JSR FPRINT
SETSG2: SKIPN T,FILPPN
MOVE T,LIBPPN
MOVEM T,FILPPN
LOOKUP DAT,FILNAM
JRST [ POP P,A
JRST LOOKRR]
DEC,< JSR DAT,LOOKCK >
NODEC,< MOVEM T,FILPPN >
OUTSTR[ASCIZ/
/]
RELEASE DAT,
POP P,A
MOVE T,FILNAM
MOVEM T,(A)
MOVE T,FILEXT
HLLZM T,1(A)
MOVE T,FILPPN
MOVEM T,3(A)
DATE T, ;USE CURRENT DATE
HRRM T,1(A)
POPJ P,
>;DEC
STUFT0: PUSHJ P,STUFT1
JRST ITSTUF
STUFT1: PUSHJ P,SETTT
STUFT2: JUMPE B,CPOPJ
MOVEI T,1(B)
HRLI T,(<POINT 7,0>)
STUFT3: PUSHJ P,GETTT
POPJ P,
PUTBYT (C)
JRST STUFT3
LTITLE: TVOFF
SKIPE T,SITE1
PUSHJ P,[OUTSTR[ASCIZ/
SITE LINE 1 /]
JRST OUTTXT]
SKIPE T,SITE2
PUSHJ P,[OUTSTR[ASCIZ/
SITE LINE 2 /]
JRST OUTTXT]
SKIPE T,TAUTHOR
PUSHJ P,[OUTSTR[ASCIZ/
AUTHOR /]
JRST OUTTXT]
SKIPE T,TIT1
PUSHJ P,[OUTSTR[ASCIZ/
TITLE LINE 1 /]
JRST OUTTXT]
SKIPE T,TIT2
PUSHJ P,[OUTSTR[ASCIZ/
TITLE LINE 2 /]
JRST OUTTXT]
SKIPN TVARIABLE
SKIPE TPREFIX
JRST DODNUM
SKIPN TMODULE
JRST NODNUM
DODNUM: OUTSTR[ASCIZ/
DRAWING NUMBER: /]
SKIPE T,TMODULE
PUSHJ P,OUTTXT
SKIPE T,TVARIABLE
PUSHJ P,[OUTCHR["-"]
JRST OUTTXT]
SKIPE T,TPREFIX
PUSHJ P,[OUTCHR["-"]
JRST OUTTXT]
NODNUM: SKIPE T,TREV
PUSHJ P,[OUTSTR[ASCIZ/
REVISION /]
JRST OUTTXT]
SKIPE T,TPROJ
PUSHJ P,[OUTSTR[ASCIZ/
PROJECT /]
JRST OUTTXT]
SKIPE T,TDCODE
PUSHJ P,[OUTSTR[ASCIZ/
DRAWING CODE = /]
JRST OUTTXT]
SKIPN T,TPAGE
SKIPE TOF
CAIA
JRST NODCOD
OUTSTR[ASCIZ/
SHEET /]
JUMPE T,.+2
PUSHJ P,OUTTXT
OUTSTR[ASCIZ/ OF /]
SKIPE T,TOF
PUSHJ P,OUTTXT
NODCOD:
DEC,<
FOR @$I IN(DRN,ENG)
< SKIPN I$NAM
JRST NLT$I
OUTSTR[ASCIZ/
I: /]
MOVEI A,I$NAM
JSR FPRINT
NLT$I:
>
SKIPE T,TNXTHI
PUSHJ P,[OUTSTR[ASCIZ/
NEXT HIGHER ASSEMBLY NUMBER = /]
JRST OUTTXT]
>;DEC
MOVE T,[OUTCHR TTT]
MOVEM T,PUTCHR
SKIPE CRDLOC
PUSHJ P,[OUTSTR [ASCIZ /
CARD LOCATION: /]
HLRZ A,CRDLOC
JRST SLTOUT]
OUTSTR [ASCIZ /
NOMENCLATURE: /]
MOVE T,NOMTYP
OUTSTR @LNAMES(T)
SKIPL T,WWTYP
JRST [ OUTSTR [ASCIZ /
BOARD TYPE: /]
OUTSTR @WNAMES(T)
JRST .+1]
OUTSTR[ASCIZ/
/]
TVON
POPJ P,
;MORE SET AND CLEAR STUFF
UNDRLN: SETOM ULNFLG
POPJ P,
NUNDRL: SETZM ULNFLG
POPJ P,
SETDMD: TLO M,DIAMONDS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/DIAMONDS AT JUNCTIONS OF 3 LINES/]
PUSHJ P,YORN
JFCL
TLZA M,JUNC3
TLO M,JUNC3 ;YES.
POPJ P,
CLRDMD: TLZ M,DIAMONDS!JUNC3
POPJ P,
>;MD
STANFO,<
SETTHK: MOVE A,STDBIG
MOVEI B,CWIDTH+1
MOVEM B,PLTPTX(A)
POPJ P,
CLRTHK: MOVE A,STDBIG
MOVEI B,CWIDTH
MOVEM B,PLTPTX(A)
POPJ P,
>;STANFO
MPC,<
STCARD: TLON M,CRDISP
TRO MCHG
POPJ P,
CLCARD: TLZE M,CRDISP
TRO MCHG
POPJ P,
;HERE WE DELETE LINES, TEXT, AND POINTS WITHOUT DRILL HOLES
;ALSO SET PAD TYPES TO 2 (CLEARANCE)
INNER: TRZ INLIN!INMOV
TRO NEEDCL
MOVEI B,PONPNT
PUSHJ P,PNTKIL
MOVEI B,PONPN2
PUSHJ P,PNTKIL
OUTSTR[ASCIZ/WELL, NOW YOU'VE REALLY DONE IT OLLY!
THIS USED TO BE A NICE PC CARD!
/]
SETZM LSTNAM ;DISABLE 
LAY,< SETZM SAVNAM >
TRO MCHG
JRST FILEUP ;UPDATE ON SCREEN
PNTKL1: FETCHL(TT,B,PBIT)
TLNE TT,CPIN
JRST STCLR1 ;CONNECTORS ARE SPCIAL
TLNE TT,ISPIN!FEEDTH
JRST STCLR
TRZ TFLG
PUSH P,A ;SAVE LAST
PUSHJ P,DELPNT ;DELETE POINT
POP P,B ;RESTORE LAST AS THIS
JRST PNTKIL
STCLR: MOVEI TT,2 ;SET CLEARANCE PAD
STORE(TT,B,PIN)
STCLR1: PUSHJ P,KILPNT ;FLUSH LINES AND TEXT
PNTKIL: MOVE A,B
FETCH(B,B,PNXT)
JUMPN B,PNTKL1
POPJ P,
PPLOT: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/PLANE NUMBER?/]
PUSHJ P,READNC
ADDI T,1
MOVEM T,CPLANE
JRST PLPLOT
MUNG: MOVE T,MODE
CAIE T,SETM ;SET MODE IS SPECIAL
JRST MUSH
JRST STMUSH ;MUSH SET ONLY
SETPWR: MOVEI D,1 ;DIVIDE BY 1 TO GET PWR PIN
MOVEI F,2 ;AND DEPOSIT A 2 (POWER PLANE)
OUTSTR[ASCIZ/CONNECT HIGHEST NUMBERED PIN OF DIP TO POWER/]
PUSHJ P,YORN
JFCL
CAIA
PUSHJ P,PWRGND
NOUML,< POPJ P,>
UML,< MOVEI E,[<ASCII/VCC/>
ASCIZ/VCC/]
PGSIGS: OUTSTR[ASCIZ/CONNECT /]
OUTSTR 1(E)
OUTSTR[ASCIZ/ RUN TO INNER PLANE/]
PUSHJ P,YORN
POPJ P,
POPJ P,
SKIPN G,WIRLST
JRST NOPGSG
PGSIG1: HRRZ C,1(G)
PGSIG2: HLRZ A,1(C)
JUMPE A,PGSIG3
ADD A,[POINT 7,1]
MOVE B,E
PUSHJ P,SIGMAT
JRST PGSIG3
JRST ISPORG ;EQUIVALENT IS CLOSE ENOUGH
JRST ISPORG
PGSIG3: HRRZ C,(C)
JUMPN C,PGSIG2
HRRZ G,(G)
JUMPN G,PGSIG1
NOPGSG: OUTSTR[ASCIZ/NO /]
OUTSTR 1(E)
OUTSTR[ASCIZ/ RUN!
/]
POPJ P,
ISPORG: HRRZ G,1(G)
ISPOR1: HLRZ E,(G)
JUMPE E,ISNPG
HLRZ A,(E)
FETCHL(B,A,PBIT)
TLNN B,ISPIN ;PINS ONLY!
JRST ISNPG
MOVE T,F
PUSHJ P,UNPLN1 ;SET PLANE # ON PIN
ISNPG: HRRZ G,(G)
JUMPN G,ISPOR1
POPJ P,
>;UML
SETGND: MOVEI D,2 ;DIVIDE BY 2
MOVEI F,1 ;AND SET TO 1 (GROUND PLANE)
OUTSTR[ASCIZ/CONNECT HALF HIGHEST NUMBERED PIN OF DIP TO GROUND/]
PUSHJ P,YORN
JFCL
CAIA
PUSHJ P,PWRGND
NOUML,< POPJ P,>
UML,< MOVEI E,[<ASCII/GND/>
ASCIZ/GND/]
JRST PGSIGS
>;UML
PWRGND: MOVE T,F
SKIPE E,PONPNT
PUSHJ P,PGSET
SKIPE E,PONPN2
PUSHJ P,PGSET
TRO MCHG
POPJ P,
PGSET: FETCHL(B,E,PBIT)
TLNN B,ISPIN
JRST NPGPIN
FETCH(B,E,BBODY)
FETCH(B,B,BTYP)
FETCH(B,B,TNAM) ;# PINS THIS TYPE
CAIG B,3 ;IS IT BIGGER THAN TRANSISTOR?
JRST NPGPIN
IDIV B,D
FETCH(C,E,BPLOC)
FETCH(C,C,TPID)
CAMN C,B
PUSHJ P,UNPLN1 ;SET PLANE FROM T
NPGPIN: FETCH(E,E,PNXT)
JUMPN E,PGSET
POPJ P,
;ROUTING PARAMETERS
ROUTE,<
SETRTE: PUSHJ P,BITINI
TLNE M,RDISP
TRO MCHG
POPJ P,
SETRDS: TLNN M,%ROUTE
PUSHJ P,BITINI ;FORCE INTIALIZATION
TLOE M,RDISP
POPJ P,
TRO MCHG
POPJ P,
CLRRDS: TLZE M,RDISP
TRO MCHG
POPJ P,
SETRCD: OUTSTR[ASCIZ/ROUTE CODE = /]
PUSHJ P,READNC
CAILE T,3
JRST PERRET
MOVEM T,RCODE
POPJ P,
SETCNR: MOVEI A,.CNR
JRST SETRT
SETFED: MOVEI A,.FED
JRST SETRT
SETBAK: MOVEI A,.BAK
JRST SETRT
SETSID: MOVEI A,.SID
SETRT: OUTSTR[ASCIZ/OLD VALUE = /]
MOVE T,(A)
PUSHJ P,DECOUT
OUTSTR[ASCIZ/
NEW VALUE = /]
PUSHJ P,SREADN
CAIE C,12 ;ENDING OK?
JRST INNERR ;NO, GET OUT
MOVEM T,(A) ;STORE NEW VALUE
POPJ P,
>;ROUTE
>;MPC
;SET CARD LOC(D,PC)
SETLOC: TLNE M,DSKACT!MACACT
JRST SETLC1
OUTSTR[ASCIZ/SET CARD LOCATION.
/]
OUTSTR @SLTCUE
OUTCHR["?"]
SETLC1: MOVE T,[PUSHJ P,GETLCH]
MOVEM T,GTCHRX
PUSHJ P,GETSLT
JRST INNERR
CAIE C,12
JRST INNERR
SKIPN C,LETTER
JRST [
MD,< SKIPN CRDLOC ;CRDLOC SET FOR WHOLE CARD?
JRST CLRLCB ;NO, SET INDIVIDUALLY
>;MD
SETZM CRDLOC
TRO MCHG
POPJ P,]
MPC,< HLLZ C,LETTER
MOVEM C,CRDLOC
TRO MCHG
POPJ P,
>;MPC
MD,< OUTSTR[ASCIZ/SHALL I SET THIS AS PERMANENT CARD LOC FOR WHOLE DWG,
OR JUST SPREAD THIS THROUGH BODIES AND CPINS (Y FOR PERM)/]
PUSHJ P,YORN
JFCL
CAIA
JRST [ MOVE T,LETTER
MOVEM T,CRDLOC
SETZM LETTER ;NOW CLEAR CRDLOC'S IN INDIVIDUAL CPINS AND BODIES
JRST CLRLCB]
SETZM CRDLOC ;CLEAR GLOBAL CRDLOC
CLRLCB: MOVEI A,DBODPN
TRO MCHG
JRST SETLCB
STLCB1: FETCH(T,A,BLOC)
JUMPE T,SETLCB ;ANY BODY LOC SET?
HLRZ TT,LETTER
STORE(TT,A,BBRS)
MOVE T,A
PUSH P,A
PUSHJ P,OFFBLO
POP P,A
SETLCB: FETCH(A,A,BNXT)
JUMPN A,STLCB1
MOVEI A,PONPNT
JRST SETLCC
STLCC1: FETCHL(TT,A,PBIT)
TLNN TT,CPIN
JRST SETLCC
FETCH(T,A,PLOC)
HLLZ TT,LETTER
HLLM TT,(T)
SETLCC: HRRZ A,(A)
JUMPN A,STLCC1
TRO MCHG!NEEDCL
POPJ P,
>;MD
SETLZ: SKIPN A,DBODPN
POPJ P,
TRO MCHG
SETLZ1:
MD,< CLEAR(A,BLOC) >
MPC,< CLEAR(A,BLN) >
FETCH(A,A,BNXT)
JUMPN A,SETLZ1
POPJ P,
;UML STUFF
MPC,<
%LIM__=300/5*2
UMLREL: SKIPE B,XUMLPN
PUSHJ P,PUTFS
SETZM XUMLPN
SKIPE B,YUMLPN
PUSHJ P,PUTFS
SETZM YUMLPN
POPJ P,
DOUML: SKIPN DBODPN ;ANYTHING TO DO IT TO?
JRST PERRET
PUSHJ P,UMLREL
OUTSTR[ASCIZ/<SMALLEST L><SMALLEST N>?/]
PUSHJ P,GETLET
JRST INNERR
SKIPG C,L2N-"A"(C) ;GET ITS NUMBER
JRST INNERR
MOVEM C,L1
PUSHJ P,READNC
JUMPE T,INNERR
MOVEM T,N1
MOVE A,DBODPN
DOUML1: FETCHL(T,A,BX)
MOVEI B,XUMLPN
PUSHJ P,DOUMLA
FETCHL(T,A,BY)
MOVEI B,YUMLPN
PUSHJ P,DOUMLA
FETCH(A,A,BNXT)
JUMPN A,DOUML1
MOVE A,DBODPN ;TAKE IT FROM THE TOP!
DOUML2: FETCHL(T,A,BX)
MOVEI B,XUMLPN
PUSHJ P,DOUMLB
ADD C,N1
FETCH(D,A,BLN)
DPB C,[POINT 6,D,29] ;STORE NUMBER
CAILE C,77
OUTSTR[ASCIZ/NUMBER OVERFLOW!
/]
FETCHL(T,A,BY)
MOVEI B,YUMLPN
PUSHJ P,DOUMLB
ADD C,L1
DPB C,[POINT 6,D,23] ;AND LETTER
STORE(D,A,BLN)
ANDI C,77 ;MAKE SURE WE DON'T GO OFF END OF TABLE
MOVE C,N2L(C)
CAIN C,"?" ;ERROR?
OUTSTR[ASCIZ/LETTER OVERFLOW!
/]
FETCH(A,A,BNXT)
JUMPN A,DOUML2
PUSHJ P,UMLREL
;MORE UML
;HERE WE CHECK FOR DUPLICATION OF LOCATION, AND TRY TO FLUSH IT
MOVE A,DBODPN
DOUML4: MOVE B,A
FETCH(B,A,BLN)
LDB C,[POINT 6,B,29] ;NUMBER
LDB B,[POINT 6,B,23] ;LETTER
MOVE D,A
CAIL B,77
CAIE C,"Z"-100
JRST DOUML6
JRST DOUML7 ;LOSE BIG, CAN'T MOVE THIS
DOUML5: FETCH(E,D,BLN)
LDB T,[POINT 6,E,23] ;LETTER
LDB TT,[POINT 6,E,29] ;NUMBER
CAMN B,T ;SAME LETTER?
CAME C,TT ;AND NUMBER?
JRST DOUML6 ;NO
FETCH(T,A,BXY)
TLO T,1
SUB T,ADDR(D,BXY) ;THIS IS DELTA X,Y
HLRE TT,T
MOVM TT,TT
HRRE TTT,T
MOVM TTT,TTT
MOVEI F,0
MOVEI G,2
TLNE T,400000
MOVEI F,1 ;-DELTA X
TRNE T,400000
MOVEI G,3 ;-DELTA Y
CAMG TTT,TT
CAIGE B,"Z"-100 ;IF LETTER IS MAX, FORCE CHANGE OF NUMBER
CAIA
EXCH G,F ;(DELTA XDELTA Y)
XCT PNTAB(G)
FETCH(T,D,BLN)
LDB B,LNTAB(G)
ADDI B,1 ;INC LETTER OR NUMBER
DPB B,LNTAB(G) ;PUT IT BACK
STORE(T,D,BLN)
MOVE C,B
MOVE E,DBODPN ;PUSH EVERYONE UP FROM HERE
DOUML7: FETCH(T,A,BLN)
LDB B,LNTAB(G)
CAML B,C ;IS GREATER OF EQUAL TO ONE WE JUST CHANGED
CAIN D,(E) ;AND NOT THE ONE WE JUST CHANGED?
CAIA ;SKIP IT
ADDI B,1 ;INCREASE IT
DPB B,LNTAB(G) ;STORE IT BACK
STORE(T,E,BLN)
FETCH(E,E,BNXT)
JUMPN E,DOUML7 ;LOOP THROUGH ALL OF THEM
JRST DOUML4 ;THEN START OVER (SEE US BE SLOW)
DOUML6: FETCH(D,D,BNXT)
JUMPN D,DOUML5 ;CONTINUE DOWN FROM CURRENT BODY
DOUML8: FETCH(A,A,BNXT)
JUMPN A,DOUML4 ;GET ANOTHER CURRENT BODY
TRO MCHG
POPJ P, ;YOU MEAN WE'RE DONE?
PNTAB: JFCL
MOVE D,A ;AD INCREASE IT
JFCL
MOVE D,A ;AD INCREASE IT
LNTAB: POINT 6,T,29 ;NUMBER
POINT 6,T,29 ;NUMBER
POINT 6,T,23 ;LETTER
POINT 6,T,23 ;LETTER
;STILL MORE UML
DUMLA1: MOVE TT,T
SUB TT,(B)
MOVE TTT,1(B)
SUB TTT,T
JUMPG TT,ABOVEA
JUMPG TTT,BELOWA
POPJ P, ;AND RETURN
ABOVEA: HLLZ TTT,(B)
SUB TTT,1(B)
ADD TTT,TT
CAMLE TTT,[%LIM,,0]
JRST DUMLA2
HLLM T,(B) ;STORE NEW TOP
POPJ P, ;AND RETURN
BELOWA: HLLZ TT,(B)
SUB TT,1(B)
ADD TTT,TT
CAMLE TTT,[%LIM,,0]
JRST DOUMLA
HLLM T,1(B)
POPJ P,
DOUMLA: MOVE E,B
HRRZ B,(B)
JUMPN B,DUMLA1
DUMLA2: GETFS(TT)
HRRM B,(TT)
HRRM TT,(E)
HLLM T,(TT)
HLLZM T,1(TT)
POPJ P,
DUMLB1: CAML T,1(B) ;IS THIS THE ONE?
POPJ P, ;YES
AOSA C
DOUMLB: SETZ C,
DUMLB2: HRRZ B,(B)
JUMPN B,DUMLB1
PUSHJ P,FUCKUP
POPJ P,
>;MPC
;COUNT THINGS
DOCNT:
MD,< SETZM COUNT
SETZM COUNT2
>;MD
MPC,< SETZM L1
>;MPC
SKIPE A,PONPNT
PUSHJ P,DOCNT1
MPC,< SETZM COUNT
SETZM COUNT2
SKIPE A,PONPN2
PUSHJ P,DOCNT1
>;MPC
MD,< MOVE T,COUNT
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ POINTS!
/]
MOVE T,COUNT2
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ CONNECTOR PINS!
/]
>;MD
MPC,< MOVE T,COUNT
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ DIP PADS.
/]
MOVE T,COUNT2
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ FEEDTHROUGHS.
/]
MOVE T,L1
PUSHJ P,MILOUT
OUTSTR[ASCIZ/ INCHES OF ETCH.
/]
>;MPC
SKIPE DBODPN
SKIPN A,BODPNT
POPJ P,
BDCNT: MOVE B,DBODPN
SETZ C,
BDCNT1: FETCH(T,B,BTYP)
CAMN T,A
ADDI C,1
FETCH(B,B,BNXT)
JUMPN B,BDCNT1
JUMPE C,BDNONE
OUTSTR[ASCIZ/
/]
MD,<
FETCH(T,A,TNAM)
PUSHJ P,OUTTXT
OUTSTR[ASCIZ/ /]
>;MD
MOVE T,C
PUSHJ P,DECOUT
MD,< FETCH(B,A,TLIB)
JUMPE B,BDNONE
PUSHJ P,LIBTAB
OUTSTR NAMBUF
>;MD
MPC,< OUTSTR[ASCIZ/ /]
FETCH(T,A,TNAM)
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ PIN DIPS/]
FETCH(T,A,TNAM)
CAIE T,2 ;2 PIN DIPS ARE SPECIAL
JRST BDNONE
FETCH(T,A,TPIN)
FETCH(T,T,TPXY) ;1/2 Y VALUE * 2
IMULI T,5 ;CONVERT TO MILS
OUTSTR[ASCIZ/ SEPERATED BY /]
PUSH P,T
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ MILS/]
POP P,T
CAIN T,=400
OUTSTR[ASCIZ/ (RESISTORS)/]
CAIN T,=300
OUTSTR[ASCIZ/ (CAPACITORS)/]
>;MPC
BDNONE: FETCH(A,A,TNXT)
JUMPN A,BDCNT
OUTSTR[ASCIZ/
/]
POPJ P,
DOCNT1: FETCHL(C,A,PBIT)
MD,< AOS COUNT ;COUNT A POINT
TLNE C,CPIN ;THESE ARE CONNECTOR PINS
AOS COUNT2
>;MD
MPC,< TLNE C,ISPIN
AOS COUNT
TLNE C,FEEDTH
AOS COUNT2
FETCH(C,A,PXY) ;GET X,Y FOR COMPARISON
FETCH(B,A,PNEB)
JUMPE B,DOCNT2 ;SKIP IF NONE
DOCNT3: MOVEI D,2
DOCNT4: XCT (D)[HLRZ E,(B)
HLRZ E,1(B)
HRRZ E,1(B)]
JUMPE E,DOCNT5
CAML C,ADDR(E,PXY) ;ONLY DO IN ONE DIRECTION
JRST DOCNT5
HLRE T,C
FETCH(TT,E,PX)
SUB T,TT
IMUL T,T
HRRE TT,C
FETCH(TTT,E,PY)
SUB TT,TTT
IMUL TT,TT
ADD T,TT
PUSHJ P,SQRT
ADDM T,L1
DOCNT5: SOJGE D,DOCNT4
HRRZ B,(B)
JUMPN B,DOCNT3
DOCNT2:
>;MPC
FETCH(A,A,PNXT)
JUMPN A,DOCNT1
POPJ P,
;BRIGHTNESS, SCALE
ITBRT: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NORMAL BRIGHTNESS?/]
MOVEI A,DEFBRT
PUSHJ P,ITBRTS
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/ADDITIONAL BLINKING BRIGHTNESS?/]
MOVEI A,BLBRT
PUSHJ P,ITBRTS
MPC,< TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/BOTH SIDES BRIGHTNESS?/]
MOVEI A,BTHBRT
PUSHJ P,ITBRTS
>;MPC
POPJ P,
ITBRTS: PUSHJ P,GETCHR
CAIN C,12
POPJ P,
CAIN C,ALTMOD
JRST ITBRTT ;NO CHANGE
CAIL C,"0"
CAILE C,"7" ;LEGAL BRIGHTNESS?
JRST [ PUSHJ P,PERRET ;NO
OUTSTR[ASCIZ/BRIGHTNESS?/]
JRST ITBRTS]
MOVEI T,-60(C)
CAME T,(A)
TRO MCHG ;GET IT DONE!
MOVEM T,(A) ;SET NEW DEFAULT BRIGHTNESS
ITBRTT: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
/]
POPJ P,
CLRBRT:
NOITS,<NODEC,< MOVEI T,1 >>
ITS,< MOVEI T,4 >
DEC,< MOVEI T,5 >
CAME T,DEFBRT
TRO MCHG
MOVEM T,DEFBRT ;DEFAULT BRIGHTNESS IS 1
STANFO,< MOVEI T,3 >
NOSTANFO,< MOVEI T,7 >
CAME T,BLBRT
TRO MCHG
MOVEM T,BLBRT
MPC,<
STANFO,< MOVEI T,5 >
NOSTANFO,< MOVEI T,7 >
CAME T,BTHBRT
TRO MCHG
MOVEM T,BTHBRT
>;MPC
POPJ P,
ITCBRT: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/CURSOR BRIGHTNESS?/]
PUSHJ P,GETCHR
CAIL C,"0"
CAILE C,"7"
JRST PERRET
MOVEI T,-60(C)
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
/]
JRST CURBRT
CLCBRT:
STANFO,< MOVEI T,3 >
ITS,< MOVEI T,7 >
DEC,< MOVEI T,5 >
III,< MOVEI T,5 >
JRST CURBRT ;START CURSOR AT BRIGHTNESS 3
ITSCAL: TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /SCALE?/]
PUSHJ P,READNC
JUMPE T,CPOPJ
CAMN T,NSCALE
POPJ P,
MOVEM T,NSCALE
JRST CHANG1
MD,<
ITSTUB: TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /STUB SIZE?/]
PUSHJ P,READNC
JUMPE T,CPOPJ
LSH T,1
MOVEM T,STBSIZ
POPJ P,
>;MD
;SIZE STUFF - ITSET, PICCEN
MD,<
PICCEN: PUSHJ P,ITSET
MOVN T,MAXX
SUB T,MINX
ASH T,-1
MOVS T,T
MOVN TT,MAXY
SUB TT,MINY
ASH TT,-1
HRR T,TT
TDZ T,[1,,1]
JUMPE T,CPOPJ
SKIPE A,PONPNT
PUSHJ P,PICCN1
SKIPE A,DBODPN
PUSHJ P,PICCN1
SKIPE A,SETPNT
PUSHJ P,PICCN1
TRO MCHG!NEEDCL
JRST HOME ;NOW CENTER PHYSICAL SCREEN
PICCN1: FETCH(TT,A,QXY)
ADJUST(ADD,TT,T)
STORE(TT,A,QXY)
HRRZ A,(A)
JUMPN A,PICCN1
POPJ P,
>;MD
ITSET: MOVSI T,400000
MOVEM T,MAXX
MOVEM T,MAXY
SETCAM T,MINX
SETCAM T,MINY
MD,< MOVEI T,10 ;DISTXT EXPECTS THIS
MOVEM T,CSCALE
SKIPE A,DBODPN
PUSHJ P,CHKBDS
>;MD
SKIPE A,PONPNT
PUSHJ P,CHKDIS
MPC,< SKIPE A,PONPN2
PUSHJ P,CHKDIS
>;MPC
HLRES MINX
HLRES MAXX
POPJ P,
;CHECK DISPLAY LIMIT, INCLUDING TEXT AND CONNECTOR BOXES
;A = POINT
CHKDIS: FETCH(T,A,PXY)
PUSHJ P,MAXMIN
TRNE M,NPTEXT ;DOING POINT TEXT?
JRST CHKDS1
FETCH(D,A,PTXT) ;TEXT POINTER
JUMPE D,CHKDS1 ;MAYBE NONE
FETCH(T,A,PXY) ;X,Y AGAIN
PUSHJ P,DISTXT ;CALC MAX AND MIN
CHKDS1:
MD,< FETCH(B,A,PBIT)
TRNE B,CPIN ;CONNECTOR PIN HERE?
TLNN M,CLOCS ;YES, DOING THEM?
JRST CHKDS2 ;NO
FETCH(T,A,PXY)
FETCH(B,A,PLOC)
MOVE C,STDBIG
HLRE TT,1(B)
IMUL TT,PLTPTX(C)
IDIV TT,VIRPTX(C)
UNSCAL TT
HRLZ TT,TT
ADD T,TT
HRRE TT,1(B)
IMUL TT,PLTPTY(C)
IDIV TT,VIRPTY(C)
UNSCAL TT
HRRZ TT,TT
ADD T,TT
TLZ T,1
PUSH P,T
TRNE M,NOCBOX
JRST CHKDS3
MOVE TT,PLTPTY(C)
ASH TT,-1
HRLZ TT,TT
SUB T,TT
CHKDS3: PUSHJ P,MAXMIN ;LOWER LEFT EXTREMES
PUSHJ P,CONCAL ;CALC LENGTH OF CONNECTOR SPEC (A)
IMUL T,PLTPTX(C)
HRLZ T,T
POP P,TT
ADD T,TT
MOVE TT,PLTPTY(C)
ADD T,TT
TLZ T,1
TRNE M,NOCBOX
JRST CHKDS4
ASH TT,-1
HRLZ TT,TT
ADD T,TT
CHKDS4: PUSHJ P,MAXMIN ;UPPER RIGHT EXTREMES
CHKDS2:
>;MD
FETCH(A,A,PNXT)
JUMPN A,CHKDIS
POPJ P,
MAXMIN: CAMLE T,MAXX
MOVEM T,MAXX
CAMGE T,MINX
MOVEM T,MINX
HRRES T
CAMLE T,MAXY
MOVEM T,MAXY
CAMGE T,MINY
MOVEM T,MINY
POPJ P,
;DISTXT - CALC MAX,MIN OF TEXT
;D = TEXCOF BLOCK (OR 2ND PART OF TEXT/PROP BLOCK)
;T = X,Y
DISTXT: HRRZ C,(D) ;ACTUAL TEXT
FETCH(C,C,TSSIZ)
SKIPN C
MOVE C,STDBIG
TRZE C,400000
TLO C,400000
HLRE TT,1(D) ;CHARACTER X,Y OFFSET (IN III POINTS?)
IMUL TT,PLTPTX(C)
IDIV TT,VIRPTX(C) ;COMPENSATE FOR CHAR SIZE DEVIATIONS
UNSCAL TT ;INTERNAL COORDS
HRLZ TT,TT
ADD T,TT ;OFFSET MAIN X,Y BY CHAR OFFSET
HRRE TT,1(D)
IMUL TT,PLTPTY(C)
IDIV TT,VIRPTY(C)
UNSCAL TT
HRRZ TT,TT
ADD T,TT
TLZ T,1
MOVE TT,PLTPTX(C) ;CHARACTER WIDTH (AS PLOTTED)
MPC,< LSH TT,1 >
PUSH P,TT
MOVE TT,PLTPTY(C) ;CHARACTER HEIGHT (AS PLOTTED)
MPC,< LSH TT,1 >
PUSH P,TT
MD,< UNSCAL TT >
TLNE C,400000 ;COMPUTE Y OF TOP OF TEXT
MOVNS TT
HRRZS TT
TLNE C,400000
MOVSS TT
PUSH P,T ;SAVE ORIG X,Y
ADJUST(ADD,T,TT) ;UPPER LEFT CORNER OF TEXT
PUSHJ P,MAXMIN ;CHECK IT
;Now find # lines, max line width of text
SETZB T,TT
ADD D,[POINT 7,1,35] ;MAKE A BYTE POINTER
DSTXT1: TLNN D,760000 ;BYTE POINTER OUT?
JRST DSTXT2
DSTXT3: ILDB TTT,D ;GET A CHAR
JUMPE TTT,DSTXT1
CAIE TTT,DBLARR ;CRLF?
AOJA T,DSTXT1 ;NO
CAILE T,(TT) ;BIGGER THAN LARGEST?
HRR TT,T ;YES
SETZ T, ;NO CHARS ON NEXT LINE YET!
ADD TT,[1,,0] ;COUNT ANOTHER LINE
JRST DSTXT1
DSTXT2: HRR D,-1(D) ;FOLLOW LINK
TRNE D,-1 ;WAS THERE ONE?
JRST DSTXT3
CAILE T,(TT)
HRR TT,T ;#LINES,,MAX LENGTH
HLRZ T,TT
HRRZS TT
IMUL T,-1(P) ;#LINES*CHAR HEIGHT
IMUL TT,-2(P) ;MAX WIDTH * CHAR WIDTH
MD,<
UNSCAL T
UNSCAL TT
>;MD
TLNN C,400000
MOVNS T ;HORIZ: -Y, VERT: +X
HRL T,TT
TLNE C,400000
MOVSS T
ADJUST(ADD,T,<(P)>)
PUSHJ P,MAXMIN ;CHECK LOWER RIGHT CORNER OF TEXT
SUB P,[3,,3]
POPJ P,
MD,<
CHKBDS: FETCH(F,A,BORI)
FETCH(T,A,BTXT)
MOVEM T,BTXLST
FETCH(B,A,BTYP)
FETCH(C,B,TLIN)
JUMPE C,NCHKLN ;ANY?
CHKLN: FETCH(T,C,QXY)
PUSHJ P,ORIENT
ADJUST(ADD,T,<ADDR(A,BXY)>)
PUSHJ P,MAXMIN
FETCH(C,C,QNXT)
JUMPN C,CHKLN
NCHKLN: TRNE M,NBTEXT
JRST NCHKT
SKIPN BTXLST
JRST CHKT0
MOVE B,BTXLST
CHKT1: FETCH(T,B,TXBIT)
TRNN T,TXBIND
JRST CHKT2
PUSH P,B
FETCH(B,B,TXIND)
PUSHJ P,DSBTXT
POP P,B
JRST CHKT3
CHKT2: PUSHJ P,DSBTXT
CHKT3: FETCH(B,B,TXNXT)
JUMPN B,CHKT1
JRST NCHKT
CHKT0: FETCH(B,B,TPROP) ;ALSO DISPLAY TEXT FROM DEF
JUMPE B,NCHKT
CHKT: PUSHJ P,DSBTXT
HRRZ B,(B)
JUMPN B,CHKT
NCHKT: HRRZ A,(A)
JUMPN A,CHKBDS
POPJ P,
DSBTXT: FETCH(T,B,TXVAL)
FETCH(T,T,TSSIZ)
TLNN M,%IDENT
JUMPE T,CPOPJ
FETCH(T,B,TXXY)
TDZ T,[1,,1]
PUSHJ P,ORIENT
ADJUST(ADD,T,<ADDR(A,BXY)>)
MOVEI D,-1+ADDR(B,TXOFF)
JRST DISTXT
>;MD
;MORE SIZE STUFF
ITSIZE: PUSHJ P,ITSET
MD,<
OUTSTR[ASCIZ/WHAT SCALE WILL YOU USE IN THE PLOT PROG?/]
PUSHJ P,READNC
JUMPE T,CPOPJ
MOVEM T,ITSSCL
>;MD
MOVE T,MAXX
SUB T,MINX
OUTSTR[ASCIZ/WIDTH OF PIC IS /]
PUSHJ P,DOSIZE
MOVE T,MAXY
SUB T,MINY
OUTSTR[ASCIZ/HEIGHT OF PIC IS /]
MD,<
PUSHJ P,DOSIZE
MOVE T,MAXX
SUB T,MINX
SCALET(T)
NODEC,< IMUL T,ITSSCL ;SCALE IT
ASH T,-3
>;NODEC
DEC,< ASH T,-2 > ;DEC SCALE LOOKS LIKE 2
MOVE TT,MAXY
SUB TT,MINY
SCALET(TT)
NODEC,< IMUL TT,ITSSCL ;SCALE IT
ASH TT,-3
>;NODEC
DEC,< ASH TT,-2 >
TRZ TFLG
MOVSI TTT,-HBXLEN
PUSHJ P,BOXCHK
MOVE TTT,[-VBXLEN,,HBXLEN]
PUSHJ P,BOXCHK
TRNN TFLG
OUTSTR[ASCIZ/NO BOX IS BIG ENOUGH.
/]
POPJ P,
BOXCHK: CAMG T,WTAB(TTT)
CAML TT,HTAB(TTT)
AOBJN TTT,BOXCHK
JUMPGE TTT,CPOPJ
TRO TFLG
OUTSTR[ASCIZ/SIZE /]
SKIPGE BTAB(TTT)
OUTCHR["V"]
OUTCHR BTAB(TTT)
OUTSTR[ASCIZ/ IS BIG ENOUGH!
/]
POPJ P,
>;MD
DOSIZE: JUMPGE T,.+2
SETZ T,
MD,< SCALET(T)
IMUL T,ITSSCL ;SCALE IT!
ASH T,-3
>;MD
MPC,< ASH T,-1 >
IDIVI T,=200
PUSH P,TT ;SAVE REMAINDER
PUSHJ P,DECOUT ;PRINT INCHES
OUTCHR["."]
POP P,T
IMULI T,5
CAIGE T,=100
OUTCHR["0"]
CAIGE T,=10
OUTCHR["0"]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ INCHES.
/]
POPJ P,
;SHOWBOX
MD,<
STANFO,<
C16: MOVEI D,"C" ;BOX SIZE C
MOVEI T,=16
MOVEM T,SSCALE ;SCALE 16
JRST C16.1
>;STANFO
SHWBOX: TLNN M,DSKACT!MACACT
NODEC,< OUTSTR[ASCIZ\<BOX LETTER><DRAWING SCALE>/<PLOT SCALE>?\]>
DEC,< OUTSTR[ASCIZ\<BOX LETTER><DRAWING SCALE>?\]>
PUSHJ P,GETLET
JRST [ CAIE C,12
JRST INNERR
CLRSHW: SKIPN SWIDTH
POPJ P,
SETZM SWIDTH
TRO MCHG
POPJ P,]
CAIE C,"V" ;ASKING FOR VERTICAL?
JRST NXVERT
PUSHJ P,GETLET
JRST INNERR
TLO C,400000 ;MARK AS VERTICAL
NXVERT: MOVE D,C ;SAVE CHAR
PUSHJ P,READN
SKIPN T
MOVE T,NSCALE
MOVEM T,SSCALE
NODEC,< SETZ T,
CAIN C,"/"
PUSHJ P,READN
>;NODEC
CAIE C,12
JRST INNERR
NODEC,< SKIPN T>
C16.1: MOVEI T,2
MOVSI TTT,-BOXLEN
CAME D,BTAB(TTT) ;THIS LETTER?
AOBJN TTT,.-1 ;NO
JUMPGE TTT,INNERR ;LOSE, NOT IN TABLE
HRRZ D,TTT ;SAVE INDEX
PUSH P,NSCALE
MOVE TT,SSCALE
MOVEM TT,NSCALE
IMULM T,SSCALE
LSH T,3
MOVEM T,CSCALE
PUSH P,D
PUSHJ P,ITSET
POP P,D
POP P,NSCALE ;RESTORE TRUE SCALE
MOVE T,MAXX
ADD T,MINX
ASH T,-1
MOVE TT,MAXY
ADD TT,MINY
ASH TT,-1
MOVE A,WTAB(D)
IDIV A,SSCALE
ASH A,1
MOVN B,A
ADD A,T
ADD B,T
HRLM A,SWIDTH
HRRM B,SWIDTH
MOVE A,HTAB(D)
IDIV A,SSCALE
ASH A,1
MOVN B,A
ADD A,TT
ADD B,TT
HRLM A,SHEIGHT
HRRM B,SHEIGHT
TRO MCHG
POPJ P,
NSHOBX: SETZM SHEIGHT
SETZM SWIDTH
TRO MCHG
POPJ P,
;PBOX
BOXSIZ: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/WHAT BOX SIZE?/]
PUSHJ P,GETLET
JRST INNERR
CAIE C,"V"
JRST NXVRT1
PUSHJ P,GETLET
JRST INNERR
TLO C,400000
NXVRT1: MOVE D,C
PUSHJ P,GETLIN
CAIE C,12
JRST INNERR
MOVSI TTT,-BOXLEN
CAME D,BTAB(TTT)
AOBJN TTT,.-1
JUMPGE TTT,PERRET
HRRZM TTT,CBOX
PUSHJ P,ITSET ;FIND MAX X,Y'S
MOVE C,CBOX ;THIS WAS CLOBBERED
MOVE T,MAXX
SUB T,MINX
MOVE TT,MAXY
SUB TT,MINY
ASH T,-2
ASH TT,-2
MOVE A,WTAB(C)
IDIV A,T
MOVE B,HTAB(C)
IDIV B,TT
CAML A,B
MOVE A,B
DEC,< ASH A,1 >
PUSH P,NSCALE
JUMPN A,.+2
MOVEI A,1
MOVEM A,NSCALE
LSH A,3 ;FUDGE TEXT SCALE BY 10
IDIV A,(P)
JUMPN A,.+2
MOVEI A,4
CAILE A,30 ;IF SIZE 3 OR LARGER WILL SHRINK PIC
JRST [ MOVE A,(P)
IMULI A,3
MOVEM A,NSCALE
MOVEI A,30
JRST .+1]
MOVEM A,CSCALE
OUTSTR[ASCIZ/ SCALING TEXT BY /]
MOVE T,CSCALE
ASH T,-4
PUSHJ P,OCTOUT
OUTCHR [" "]
MOVE T,CSCALE
ASH T,-1
ANDI T,7
ADDI T,60
OUTCHR T
OUTSTR[ASCIZ %/8
%]
MOVE T,CSCALE
CAIGE T,10
OUTSTR[ASCIZ/SOME OF THIS TEXT WILL BE AWFULLY SMALL!
/]
PUSHJ P,DPLOT
POP P,NSCALE
POPJ P,
;SLICE
DOSLICE:PUSHJ P,SLCSET
POPJ P,
SETZM FIND
SKIPE E,PONPNT
PUSHJ P,ACLRP
SKIPN C,PONPNT
JRST SLEAVE
SLOP: PUSHJ P,SLOPDO
JRST SLOPX
JRST SLOPY
TRO MCHG ;WILL CHANGE PIC
MOVE T,[POINT 7,SIGBUF]
JRST SLOPZ1
SLOPZ2: TLNE A,760000
JRST SLOPZ3
HRRZ TTT,-1(A)
JUMPN TTT,SLOPZ4
GETBLK(TTT,TEXSTR)
CLEAR(TTT,TSNXT)
CLEAR(TTT,TSASC)
SLOPZ4: HRR A,TTT
SLOPZ3: IDPB TT,A
SLOPZ1: ILDB TT,T
JUMPN TT,SLOPZ2
CAIA
IDPB TT,A
TLNE A,760000
JRST .-2
SOS A
FETCH(B,A,TSNXT)
CLEAR(A,TSNXT)
PUSHJ P,PUTFS
HRLM C,(P)
MOVE A,C
PUSHJ P,FIXEM ;FIX OFFSETS IF BITS ON
HLRZ C,(P)
SLOPX: FETCH(C,C,PNXT)
JUMPN C,SLOP
MOVE T,FIND
MOVEM T,FNDNUM ;STORE FOR MACRO CALL AT ;R
JUMPE T,SLEAVE
SETOM FIND
TLNE M,DSKACT!MACACT
JRST SLEAVE
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ EXPRESSION ERRORS FOUND AND MARKED FOR $F.
/]
SLEAVE: PUSHJ P,SLCRET
POPJ P,
SLOPY: SETBIT(FOUNDP,T,C,PBIT)
AOS FIND
JRST SLOPX
CLTSLC: TLOA WFLAG ;STORE IN MACRO SLICED FORM OF TEXT
TYPSLC: TLZ WFLAG ;TYPE THE SLICED FORM OF CLOSEST TEXT
MOVEI T,1
LSH T,@MODE
TDNN T,[1PNTM!1TXTM]
JRST PERRET
PUSHJ P,GETCLS
JRST PERRET
FETCH(T,A,PTXT)
JUMPE T,PERRET
PUSHJ P,SLCSET
POPJ P,
MOVE C,CLOSES
PUSHJ P,SLOPDO
JRST SLEAVE
JRST EXPERR
PUSHJ P,SLCRET
TLNE WFLAG
JRST TYPSL1
OUTSTR SIGBUF ;PRINT CONVERTED SIGNAL NAME
POPJ P,
EXPERR: OUTSTR [ASCIZ /ERROR IN EXPRESSION(S):
/]
MOVE T,CLOSES
FETCH(T,T,PTXT)
PUSHJ P,OUTTXT
OUTSTR [ASCIZ /
/]
JRST SLEAVE
TYPSL1: PUSHJ P,SETTT
MOVE T,[POINT 7,SIGBUF]
TYPSL2: ILDB C,T
JUMPE C,ITSTUF
PUTBYT (C)
JRST TYPSL2
;MORE SLICE STUFF - EXPRESSION SUBRS
SLCSET: SETOM DOVARS
SETZM ERRVAR
MOVNI T,400000
MOVEM T,LOWER
MOVEI T,377777
MOVEM T,UPPER
MOVEM T,WIDTH
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/LOWER BOUND<UPPER BOUND>?/]
PUSHJ P,SREADN
CAIE C,74 ;LEFT BROKET
JRST NOLOWR
MOVEM T,LOWER
PUSHJ P,SREADN
NOLOWR: CAIN C,12
JUMPE T,NOUPPR
CAIE C,76
JRST [
SLERR: PUSHJ P,SCARF
POPJ P,
OUTSTR[ASCIZ/BOUNDS ERROR!
/]
JRST DOSLICE]
MOVEM T,UPPER
SUB T,LOWER
ADDI T,1
MOVEM T,WIDTH
PUSHJ P,GETLIN
NOUPPR: CAIE C,12
JRST SLERR
VARSET: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/SET VARIABLES, LN?/]
VARCON: PUSHJ P,GETLET
JRST [ CAIN C,12 ;NO VARIABLES?
JRST CPOPJ1 ;YES
VARERR: PUSHJ P,SCARF
JRST SLCRET
OUTSTR[ASCIZ/VARIABLE INPUT ERROR!
/]
JRST VARSET]
MOVE A,C
SETZM NDIG
PUSHJ P,SREADN
CAIE C,12
CAIN C,","
CAIA
JRST VARERR
GETFS(TT)
HRL A,NDIG ;SAVE WIDTH WITH VAR
MOVEM A,1(TT)
HRLM T,(TT)
EXCH TT,VARLST
HRRM TT,@VARLST
CAIE C,12
JRST VARCON
JRST CPOPJ1
SLOPDO: FETCH(A,C,PTXT)
JUMPE A,CPOPJ
AOS (P) ;SKIP TO INDICATE ATTEMPT
FETCH(A,A,TCSTR)
ADD A,[POINT 7,1]
PUSH P,A
PUSHJ P,SIGSUB
JRST [ POP P,(P)
POPJ P,] ;LET HIGHER UPS HANDLE ERROR
POP P,A
SKIPN EXPER2 ;NO SKIP IF ERROR
AOS (P)
POPJ P,
SLCRET: SKIPE B,VARLST
PUSHJ P,PUTFS
SETZM VARLST
POPJ P,
GETVAR:SKIPN TT,VARLST
JRST GETVR2 ;IGNORE THIS EXPR IF VAR NOT SET
GETVR1: HLL TTT,1(TT) ;MAKE SURE WIDTH MATCHES
CAMN TTT,1(TT) ;IS THIS THE VARIABLE?
JRST ISVAR ;YES
HRRZ TT,(TT)
JUMPN TT,GETVR1
TLZ TTT,-1
GETVR2: SETOM EXPER2 ;FLAG ERROR
MOVEI TT,1
LSH TT,-"A"(TTT)
TDNE TT,ERRVAR ;HAVE WE COMPLAINED ABOUT THIS ONE YET?
JRST GETVR3
IORM TT,ERRVAR
OUTSTR[ASCIZ/NO VALUE FOR VARIABLE "/]
OUTCHR TTT
OUTSTR[ASCIZ/".
/]
POPJ P,
GETVR3: SETZ TT,
JRST CPOPJ1 ;AND RETURN 0
ISVAR: HLRZ TTT,TTT
CAMLE TTT,NDIG
MOVEM TTT,NDIG
HRRZ TTT,1(TT) ;GET CHAR BACK
HLRE TT,(TT)
JRST CPOPJ1
>;MD
SIGGET:TLNN A,760000
JRST [ TRNN A,-1 ;ALREADY AT END?
JRST ISENDG
HRR A,-1(A)
TRNE A,-1
JRST .+1
ISENDG: SETZ TTT,
POPJ P,]
ILDB TTT,A
JUMPN TTT,CPOPJ
JRST SIGGET ;GET ANOTHER IF NULL
;XCLEAR
XCLEAR: MOVEI T,1
LSH T,@MODE
TDNE T,[MD,<ALLEDM!>ANYALT]
JRST PERRET
PUSH P,0 ;SAVE FLAGS FOR MERGING
PUSH P,M
PUSHJ P,RSTDEF ;DEFAULTS FOR RESTART
POP P,T
AND T,[XWD DSKFLG!DSKACT!MACACT,0]
IOR M,T
POP P,T
AND T,[XWD DSPACT,0]
IOR 0,T
NODEC,<
NOIII,< SETZM AUTOSM ;RESET AUTO WRITE AND SAVE COUNTERS
SETZM AUTOSN
>;NOIII
>;NODEC
MD,<
FOR I IN(SITE1,SITE2,TAUTHOR,TIT1,TIT2,TREV,TMODULE,TVARIABLE,TPREFIX,TPROJ,TPAGE,TOF,TDCODE)
< SKIPE B,I
PUSHJ P,PUTFS
SETZM I
>
DEC,< SKIPE B,TNXTHI
PUSHJ P,PUTFS
SETZM TNXTHI
SETZM DRNNAM
SETZM CHKNAM
SETZM ENGNAM
>;DEC
SETZM SWIDTH ;CLEAR SHOWBOX
PUSHJ P,CLRWW
>;MD
PUSHJ P,CLRNOM
SETZM CRDLOC ;CLEAR CARD LOCATION IN BOTH
SKIPN A,MDPNT
JRST NCMSAV
MOVSI B,MSAVE
CMSAVE: ANDCAM B,(A) ;TURN OFF SMACRO BITS ON CLEAR
HRRZ A,(A)
JUMPN A,CMSAVE
NCMSAV: SKIPE B,BLPNTR
PUSHJ P,PUTFS
SETZM BLPNTR
SETZM MOVED
MPC,<
IFN UMLSW!LAYSW,<
SETZM UPINS
>;IFN UMLSW!LAYSW
ROUTE,< SETZM RCL1
SETZM RCL2
>;ROUTE
SHORT,< SKIPE A,SHRTER
PUSHJ P,GIVERR
SETZM SHRTER
SETZM SERR1
SETZM SERR2
>;SHORT
>;MPC
UML,< PUSHJ P,RELWIR > ;RELEASE WIRE LIST
SKIPE B,FBDLST
PUSHJ P,PUTFS
SETZM FBDLST
LAY,< SETZM LAYLOC
SETZM SAVNAM
>;LAY
SETZM LSTNAM
PUSHJ P,FILEUP
SETZM BID
SETZM PID
SKIPE SETPNT
PUSHJ P,SBLAST
SKIPE A,DBODPN
PUSHJ P,BFLUSH
SETZM DBODPN
SKIPE A,PONPNT
PUSHJ P,PFLUSH
SETZM PONPNT
MPC,< SKIPE A,PONPN2
PUSHJ P,PFLUSH
SETZM PONPN2
PUSHJ P,CRDREL ;FLUSH PC CARD
>;MPC
MD,< SKIPE A,BODPNT
PUSHJ P,DFLUSH
SETZM BODPNT
SKIPN A,LIBLST
POPJ P,
LCLEAR: HRRZ B,(A)
HLRZ C,(A)
FSTRET(A)
FSTRET(C)
MOVE A,B
JUMPN A,LCLEAR
SETZM LIBLST
>;MD
POPJ P,
PFLUSH: FETCH(B,A,PLOC)
FETCHL(T,A,PBIT)
TLNN T,CPIN
JRST PFLSH1
FSTRET(B)
PFLSH1: FETCH(B,A,PTXT)
PUSHJ P,PUTFS
MOVE C,A
FETCH(A,A,PNXT)
RETBLK(C,POINT)
JUMPN A,PFLUSH
POPJ P,
;BFLUSH - RELEASE BODY LIST IN A
BFLUSH: MOVE B,A
FETCH(A,A,BNXT)
MD,< PUSH P,A
FETCH(C,B,BTXT)
PUSHJ P,TXTREL
POP P,A
>;MD
RETBLK(B,BODY)
JUMPN A,BFLUSH
POPJ P,
MD,<
DFLUSH: FETCH(B,A,TNXT)
PUSH P,B
PUSHJ P,TYPREL
POP P,A
JUMPN A,DFLUSH
POPJ P,
>;MD
;**C, OFFSET, MOVE, POSIT
CCENTR: HRL T,XOFF
HRR T,YOFF
JRST SETPOS ;PUT CURSOR THERE
PCENTR: MOVE T,CURSE
PICSET: HLREM T,XOFF
HRREM T,YOFF
JRST CHANGE
HOME: SETZM XOFF
SETZM YOFF
MOVEI T,0
JRST CHANGE
SETXOF: PUSHJ P,SETOFF
JRST PERRET
MOVEM T,XOFF
JRST CHANG1
SETYOF: PUSHJ P,SETOFF
JRST PERRET
MOVEM T,YOFF
JRST CHANG1
SETOFF: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/ABSOLUTE OFFSET?/]
PUSHJ P,SREADN
CAIE C,12
POPJ P, ;LOSE
MD,< ASH T,1
CAIL T,377777
POPJ P, ;OOPS!
JRST CPOPJ1 >
MPC,< ASH T,1
IDIVI T,5
JUMPN TT,ILLSTP
IDIV T,STPSIZ
JUMPN TT,ILLSTP
IMUL T,STPSIZ
CAIL T,377777
POPJ P,
JRST CPOPJ1 >
MPC<
STPERR: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/ILLEGAL STEP SIZE!
/]
SETSTP: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/MINIMUM STEP IN MILS(DIVISIBLE BY 5 MILS)?/]
PUSHJ P,READNC
JUMPE T,INNERR
IDIVI T,5
JUMPN TT,STPERR
JUMPE T,STPERR
MOVEM T,STPSIZ
JRST CHANG1
>;MPC
MOVREL: TLNN M,DSKACT!MACACT
MD,< OUTSTR[ASCIZ/RELATIVE X,Y?/] >
MPC,< OUTSTR[ASCIZ/RELATIVE X,Y(IN MILS)?/] >
PUSHJ P,SREADN
CAIN C,ALTMOD
POPJ P,
PUSH P,T
CAIN C,12
TDZA T,T ;JUST X
PUSHJ P,SREADN
CAIN C,ALTMOD
JRST [ POP P,(P)
POPJ P,]
ASH T,1
MPC,<
IDIVI T,5
JUMPN TT,[ POP P,(P)
JRST ILLSTP]
>;MPC
POP P,TT
ASH TT,1
MPC,<
TRNE M,FLIP
MOVN TT,TT
IDIVI TT,5
JUMPN TTT,ILLSTP
IDIV TT,STPSIZ
JUMPN TTT,ILLSTP
IMUL TT,STPSIZ
MOVE TTT,TT
IDIV T,STPSIZ
JUMPN TT,ILLSTP
IMUL T,STPSIZ
MOVE TT,TTT
>;MPC
HRL T,TT
ADJUST(ADD,T,CURSE)
JRST SETPOS
MPC,<
ILLSTP: OUTSTR[ASCIZ/NOT INTEGRAL # OF STEPS!!!!
/]
POPJ P,
POSIT: TLNE M,DSKACT!MACACT
POPJ P,
OUTSTR[ASCIZ/CURSOR /]
MOVE T,CURSE
PUSHJ P,PNTXY
OUTSTR[ASCIZ/
/]
MOVEI T,1
LSH T,@MODE
TDNN T,[1PNTM!1TXTM]
POPJ P,
PUSHJ P,GETCLS
POPJ P,
FETCH(T,A,PXY)
CAMN T,CURSE
POPJ P,
OUTSTR[ASCIZ/POINT /]
PUSHJ P,PNTXY
OUTSTR[ASCIZ/
/]
POPJ P,
PNTXY: HRLM T,(P)
HLRE T,T
PUSHJ P,MILOUT
OUTCHR[11]
HLRE T,(P)
MILOUT: SKIPGE T
OUTCHR["-"]
MOVM T,T
IDIVI T,=1000*2/5
PUSH P,TT
PUSHJ P,DECOUT
POP P,T
OUTCHR["."]
IMULI T,5
ASH T,-1
CAIGE T,=100
OUTCHR["0"]
CAIGE T,=10
OUTCHR["0"]
JRST DECOUT
>;MPC
;CHECK IF LOC IN T IS ON SCREEN, IF NOT GET IT ON.
;REGARDLESS, MOVE CURSOR THERE
CHKON: TLNE M,DSKACT!MACACT
JRST SETPOS
PUSHJ P,ONSCR
JRST PICSET
JRST SETPOS
;BIG, SMALL, SHIFT SCREEN
MAKBIG: MOVEI T,1
LSH T,@MODE
TDNE T,[ANYALT]
JRST PERRET
MOVE T,NSCALE ;GET CURRENT SCALE
XCT (A)[CAIA ;INCREMENT SIZE BY ONE
LSH T,-2 ;MULT BY 1,25
LSH T,-1 ;MULT BY 1,5
JFCL] ;MULT BY 2
JUMPN T,.+2
MOVEI T,1
ADDM T,NSCALE
CHANG1: MOVE T,CURSE
CHANGE: PUSH P,T
PUSH P,TT
TRO MCHG ;WE ARE CHANGING IT
TLNN M,XWINDOW ;IF WINDOWING, CLOSEST MAY CHANGE
TRO NEEDCL
SETOM CLOSUP ;BIG LETTER WILL MOVE IN ANY CASE
MPC,< MOVE T,[%RIGHT4] >
MD,< MOVE T,[%RIGHT2] >
PUSHJ P,TRUNCP
ADD T,XOFF
HRLZM T,RIGHT
MPC,< MOVE T,[%TOP4] >
MD,< MOVE T,[%TOP2] >
PUSHJ P,TRUNCP
ADD T,YOFF
MOVEM T,TOP
MPC,< MOVE T,[%LEFT4] >
MD,< MOVE T,[%LEFT2] >
PUSHJ P,TRUNCN
ADD T,XOFF
HRLZM T,LEFT
MPC,< MOVE T,[%BOTTOM4] >
MD,< MOVE T,[%BOTTOM2] >
PUSHJ P,TRUNCN
ADD T,YOFF
MOVEM T,BOTTOM
POP P,TT
POP P,T
JRST SETPOS
TRUNCP: PUSHJ P,TRUNCD
SKIPGE TT
SUBI T,2
POPJ P,
TRUNCN: PUSHJ P,TRUNCD
SKIPLE TT
ADDI T,2
POPJ P,
TRUNCD: MOVE TT,NSCALE
MPC,< IMUL TT,STPSIZ >
ASH TT,1
IDIV T,TT
MPC,< IMUL T,STPSIZ >
ASH T,1
POPJ P,
MAKSML: MOVEI T,1
LSH T,@MODE
TDNE T,[ANYALT]
JRST PERRET
MOVE T,NSCALE ;GET CURRENT SCALE
LSH T,2
XCT (A)[SOS T,NSCALE ;DECREMENT BY 1
IDIVI T,5 ;MULT BY 4/5
IDIVI T,6 ;MULT BY 2/3
ASH T,-3] ;MULT BY 1/2
SKIPN T ;0?
MOVEI T,1 ;YES, MAKE 1
MOVEM T,NSCALE
JRST CHANG1
MAKRIT: PUSHJ P,GETMAK
JRST PERRET
MPC,< TRNE M,FLIP
MOVN T,T
>;MPC
EXCH T,XOFF
SUBM T,XOFF
JRST CHANG1
MAKLFT: PUSHJ P,GETMAK
JRST PERRET
MPC,< TRNE M,FLIP
MOVN T,T
>;MPC
ADDM T,XOFF
JRST CHANG1
MAKDWN: PUSHJ P,GETMAK
JRST ALTDWN
ADDM T,YOFF
JRST CHANG1
MAKUP: PUSHJ P,GETMAK
JRST ALTUP
EXCH T,YOFF
SUBM T,YOFF
JRST CHANG1
GETMAK: MOVEI T,1
LSH T,@MODE
TDNE T,[ANYALT]
JRST ALTMAK
MD,< MOVEI T,1 >
MPC,< MOVEI T,2 >
ASH T,11(A)
IDIV T,NSCALE
SKIPN T
MOVEI T,1 ;NEVER MOVE NONE
MPC,< ADD T,STPSIZ ;ROUND UP
SUBI T,1
IDIV T,STPSIZ
IMUL T,STPSIZ
ASH T,1
>;MPC
JRST CPOPJ1
ALTMAK: MOVEI T,1
LSH T,(A)
POPJ P,
ALTDWN: MOVN T,T ;DECREASE START LINE, (MOVE TEXT DOWN)
ALTUP: ADDM T,ALTLIN
SKIPGE ALTLIN
SETZM ALTLIN ;AVOID UNDERFLOW
SETOM LPNTR
TRO MCHG
POPJ P,
;MODE SWITCHING
DEFINE MODC(A)
< MOVEI T,A
JRST CHNGMD>
TOP3P: MODC(PNTM)
TOP3B: MODC(BODM)
TOP3L: MODC(LINM)
TOP3S: MODC(SETM)
TOP3T: MODC(TXTM)
CMODE: CLRSET ;S
CLRPNT ;B
CLRPNT ;P
CPOPJ ;L
CLRPNT ;T
CPOPJ ;A
CPOPJ ;MA
CPOPJ ;SP
MD,< CLRPNT ;BT
CPOPJ ;BTA
CLRPNT ;E
CLREDI ;EI
CLRPNT ;ET
CLRPNT ;EP
CLRGET ;EG
CPOPJ ;EA
>;MD
REPEAT NUMODES+<CMODE-.>,<CPOPJ>
;RESTORE MODE AFTER TCHNGM
RCHNGM: MOVE T,OMODE ;RESET TO OLD MODE
;PERMANENT MODE CHANGE
CHNGMD: MOVEM T,OMODE
;TEMPORARY MODE CHANGE, LEAVE OMODE A LAST CHNGMD
TCHNGM: CAMN T,MODE ;ARE WE REALLY CHANGING?
POPJ P,
TRO NEEDCL ;MUST CALL FNDCLS
EXCH T,MODE ;NEW MODE
JRST @CMODE(T)
CLRSET: TRZE STBOX ;WERE WE DRAWING A BOX?
SKIPN B,SETBOX
JRST CLRPNT ;NO
PUSHJ P,PUTFS
MOVEI T,ANGLPG
PUSHJ P,HYDPOG
SETZM SETBOX
JRST CLRPNT
MD,<
CLRGET: MOVEI T,ANGLPG
JRST HYDPOG
CLREDI: SKIPN A,CRPPNT
JRST CLRPNT
MOVEI T,1
AND T,1(A)
IOR T,CURSE
MOVEM T,1(A)
>;MD
CLRPNT: TRZ INLIN!INMOV
POPJ P,
;SIXBIT, FILEUP
LSIXOUT:
IFN DECSW!IIISW,< HLRZ T,TT
LSIXOD: IDIVI T,10
HRLM TT,(P)
JUMPE T,.+2
PUSHJ P,LSIXOD
HLRZ T,(P)
ADDI T,60
IDPB T,TTT
POPJ P,
>;IFN DECSW!IIISW
NODEC,<
NOIII,<
TLNN TT,777700
LSH TT,14
TLNN TT,770000
LSH TT,6
>;NOIII
>;NODEC
SIXOUT: JUMPE TT,CPOPJ
SETZ T,
LSHC T,6
ADDI T,40
IDPB T,TTT
JRST SIXOUT
FILEUP: SKIPN ISDPY
POPJ P,
MOVEI T,1
MOVEM T,NAMBUF
MOVE T,[NAMBUF,,NAMBUF+1]
BLT T,NAMBUF+NFWRDS-1
SKIPN TT,LSTNAM
LAY,< SKIPE SAVNAM
CAIA
>;LAY
JRST NOLAST
MOVE TTT,[POINT 7,NAMBUF]
LAY,< JUMPE TT,NOFLST >
PUSHJ P,SIXOUT
MOVEI T,"."
IDPB T,TTT
HLLZ TT,LSTEXT
PUSHJ P,SIXOUT
MOVE TT,LSTPPN
PUSHJ P,UPPPN
LAY,<
NOFLST: SKIPN TT,SAVNAM
JRST NOLAST
MOVEI T,"&"
IDPB T,TTT
PUSHJ P,SIXOUT
MOVEI T,"."
IDPB T,TTT
HLLZ TT,LSTEXT
PUSHJ P,SIXOUT
MOVE TT,SAVPPN
PUSHJ P,UPPPN
>;LAY
JRST NOLAST
UPPPN: MOVEI T,"["
IDPB T,TTT
NOCMU,<
HRLM TT,(P)
HRRI TT,0
PUSHJ P,LSIXOUT
MOVEI T,","
IDPB T,TTT
HLLZ TT,(P)
PUSHJ P,LSIXOUT
>;NOCMU
CMU,<
MOVE T,[TT,,PPNBUF]
DECCMU T,
JRST [ PUSHJ P,LSIXOUT
JRST PPNDN2 ]
SKIPA TT,[POINT 7,PPNBUF]
IDPB T,TTT
ILDB T,TT
JUMPN T,.-2
PPNDN2:
>;CMU
MOVEI T,"]"
IDPB T,TTT
POPJ P,
Reference in New Issue View Git Blame Copy Permalink