github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-28 09:27:41 +00:00
Code Issues Releases Wiki Activity
Files
9d52bc41d79aa5edd4eb9e51ff19df26e7fe961a
PDP-10.its/src/draw/mac.502
Lars Brinkhoff 33074b453f SUDS - Stanford University Drawing System.
2018-05-05 19:19:09 +02:00

2130 lines
45 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>MAC.FAI.65, 15-NOV-75 18:06:33, EDIT BY HELLIWELL
VERSION(MAC,5)
CHARIN: MOVE P,CHARP
MOVEM C,CHARP
TIMER C,
MOVEM C,BOOPLR
PUSHJ P,POPIT
MOVE C,CHARP ;RETURN CHAR IN C
POPJ P,
GREADY: PUSHJ P,READY
MOVEM 0,SAVER0
MOVEM M,SAVERM
SKIPN BOOPCN
POPJ P,
PUSH P,T
TIMER T,
SUB T,BOOPLR
ADDM T,BOOPLR
IDIVI T,=60
CAMGE T,BOOPCN
JRST GRDY1
PUSH P,[3]
SKIPA T,[1]
GRDY2: SLEEP T,
OUTCHR[7]
SOSL (P)
JRST GRDY2
POP P,(P)
GRDY1: POP P,T
POPJ P,
CMU,<
XCHRIN: EXCH C,CHKSVC ;SAVE CHAR AND GET BACK C
PUSHJ P,PUSHIT ;SAVE THE REGISTERS
SUBM P,P-17(P) ;MAKE THE SAVED P RELATIVE
CMU,< JSP TT,INATYO ;SAVE THE CURRENT POG INFO IN THE GDP2
SAVPOG
PASREGS
PUSHJ P,DOATYO
PUSH P,IIIX ;SAVE THE PDP-10 INFO TOO!
PUSH P,IIIY
PUSH P,IIIBRT
PUSH P,CHRSCL
PUSH P,PGLASS
>;CMU
MOVE T,P
MOVE P,CHARP ;POP THE STACK
SUB T,P ;FIGURE OUT HOW MUCH WE POPPED
CAMLE T,[PSVLEN,,PSVLEN] ;SEE IF IT'S TOO MUCH
JRST [ OUTSTR [ASCIZ/INTERNAL ERROR: PSVLEN IS TOO SMALL FOR SAVING THE PDL IN ROUTINE XCHRIN
/]
HALT . ]
MOVEM T,PSVCNT
HRLZI TT,1(P)
HRRI TT,PDLSAV
BLT TT,PDLSAV-1(T) ;SAVE THE STUFF ON THE STACK
PUSHJ P,POPIT
JSP C,[ EXCH C,DSPDSP
MOVEM C,C
MOVE C,CHKSVC
POPJ P, ] ;AND RETURN TO THE CALLER OF THE DISPLAY ROUTINES.
;WE GET HERE (@DSPDSP) WHEN WE DECIDE TO CONTINUE BECAUSE MCHG=0.
MOVE P,CHARP ;RESTORE THE PDL
HRLZI TT,PDLSAV
HRRI TT,1(P)
ADD P,PSVCNT ;BUMP THE PDL POINTER
BLT TT,(P) ;RESTORE THE CONTENTS
CMU,< JSP TT,INATYO ;RESTORE THE CURRENT POG INFO IN THE GDP2
RSTPOG
PASREGS
PUSHJ P,DOATYO
POP P,PGLASS ;RESTORE THE PDP-10 INFO ABOUT THE POG.
POP P,CHRSCL
POP P,IIIBRT
POP P,IIIY
POP P,IIIX
>;CMU
SUBM P,P-17(P) ;RE ABSOLUTIZE THE SAVED P
PUSHJ P,POPIT
POPJ P,
>;CMU
MACDSP: TLNN DSPACT ;DISPLAYING?
JRST CPOPJ1 ;NO, SAY WE'RE DONE
MOVEM C,CINST ;STORE INSTRUCTION TO GET CHAR
PUSHJ P,PUSHIT
MOVEM P,CHARP
CHECKIN
PUSHJ P,GETCLS ;UPDATE IT BEFORE DISPLAYING IT
JFCL
PUSHJ P,UPCLOS
PUSHJ P,PMODE
PUSHJ P,UPSCAL
PUSHJ P,UPLVL
PUSHJ P,UPCURS
PUSHJ P,DOSLPB
CHECKIN
PUSHJ P,DISP
NOCMU,< PUSHJ P,DOPOGS > ;HIDE ANY REQUESTED POGS
PUSHJ P,POPIT
JRST CPOPJ1
GETLET: PUSHJ P,GETLIN
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
CAIL C,"A"
CAILE C,"Z"
POPJ P,
JRST CPOPJ1
GETLCH: PUSHJ P,GETLIN
CAIL C,"A"+40
CAILE C,"Z"+40
POPJ P,
SUBI C,40
POPJ P,
YORN: TLNN M,DSKACT!MACACT
OUTCHR["?"]
PUSHJ P,GETCH
JRST YORN
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
/]
CAIN C,ALTMOD
POPJ P,
AOS (P)
CAIE C,"Y"
CAIN C,"y"
AOS (P)
POPJ P,
YORNTT: OUTCHR["?"]
INCHRW C
OUTSTR[ASCIZ/
/]
CAIN C,ALTMOD
POPJ P,
AOS (P)
CAIE C,"Y"
CAIN C,"y"
AOS (P)
POPJ P,
GETLI1: TLNN M,DSKACT!MACACT
NOSKEY,< OUTSTR[ASCIZ/
/]
>;NOSKEY
SKEY,< OUTSTR[ASCIZ/
^/]
>;SKEY
GETLIN:PUSHJ P,GETLN
JRST GETLI1
POPJ P,
GETCHM: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
*/]
PUSHJ P,GETCH
JRST GETCHM
POPJ P,
GETCHR: TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /
_/]
PUSHJ P,GETCH
JRST GETCHR
POPJ P,
GETLN: SETZM BITS
SKIPE C,INPNT
JRST GETMAC ;GETTING INPUT INTERNALLY
TLNE M,DSKACT
JRST [ PUSHJ P,DSKCHR
POPJ P,
JRST GETCAN]
GETLP2: MOVE C,[INCHSL C]
PUSHJ P,MACDSP
JRST GOTCL
PUSHJ P,GREADY
INCHWL C
III,< CAIN C,33
MOVEI C,11
>;III
PUSH P,T
TIMER T,
MOVEM T,BOOPLR
POP P,T
PUSHJ P,NREADY
GOTCL:
CMU,< ;I'M NOT SURE EVERYONE WANTS THIS, THOUGH THEY PROBABLY DO
CAIN C,177 ;IGNORE SPURIOUS RUBOUTS IN LINE MODE!
JRST GETLP2
>;CMU
JRST GETCAN
GETCH: SKIPE C,INPNT ;GETTING INPUT INTERNALLY?
JRST GETMAC ;YES
ZERBTS: SETZM BITS
GETLP1: TLNE M,DSKACT
JRST [ PUSHJ P,DSKCHR
POPJ P,
JRST GETCAN]
III,< MOVE C,[INSKIP]
PUSHJ P,MACDSP
CAIA
PUSHJ P,GREADY
PUSHJ P,UPLHY ;UPDATE DISPLAY
TTCALL 17,C ;READ CHAR WITH BITS
>;III
NOIII,< MOVE C,[INCHRS C]
PUSHJ P,MACDSP
JRST GETCAN
PUSHJ P,GREADY
INCHRW C
>;NOIII
PUSH P,T
TIMER T,
MOVEM T,BOOPLR
POP P,T
PUSHJ P,NREADY
GETCAN: SKIPE LCFLAG ;CONVERT LC TO UC?
JRST NOLCCN ;NO
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
NOLCCN:
SKEY,<
III,< CAIE C,11 > ;MAKE TAB BE THE C-M-BIT KEY
NOIII,< CAIE C,33 >
CAIN C,175
JRST ALTXFN
CAIN A,176
JRST [
ALTXFN: MOVEI C,200 ;PUT IN CONTROL-META BITS
ADDB C,BITS
TRNN C,1000 ;OVERFLOW?
JRST GETLP1 ;NO
MOVEI C,ALTMOD
SETZM BITS
JRST .+1]
CAIN C,177 ;BS?
JRST [ SKIPN BITS ;ONLY IF BITS TYPED, SO LOSER CAN TYPE BS
JRST .+1
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/XXX /]
JRST ZERBTS]
>;SKEY
NOSKEY,<
CAIN C,CTRL
JRST [ MOVEI C,200
MOVEM C,BITS
JRST GETLP1]
CAIN C,META
JRST [ MOVEI C,400
MOVEM C,BITS
JRST GETLP1]
CAIN C,CTLMTA
JRST [ MOVEI C,600
MOVEM C,BITS
JRST GETLP1]
CAIN C,TTYCM
JRST [
NOCMU,< SKIPE ISDPY
JRST DODEPA
>;NOCMU
MOVE C,BITS
TRCE C,200
TRC C,400
MOVEM C,BITS
JRST GETLP1]
>;NOSKEY
CAIN C,15
JRST GETLP1
IOR C,BITS
DODEPA:
ITS,< CAIE C,14 > ;FF refreshes display also
CAIN C,600+"!" ;IS THIS THE MAGIC CHAR.?
JRST [ PUSHJ P,DSPOUT ;yes, refresh display
POPJ P,]
CAIN C,600+LAMBDA ;DISK CONTINUE CHAR?
JRST DSKCON ;YES, CONTINUE IT
TLNE M,DSKACT ;DOING DISK INPUT?
JRST DODEPB ;YES, NO OUTPUT CHECK!
SKIPE DSKOPN ;DISK OUTPUT?
PUSHJ P,DSKOCHR ;YES
DODEPB: CAIE C,12 ;DEC ONLY USES LF
JRST DODEP
PUSH P,T
MOVE T,MACPNT
SKIPL -4(T) ;I ACTIVE?
JRST TREST ;NO, RESTORE T AND GO ON
MOVEI C,200+":" ;IT IS, CHANGE TO END OF ;I
TREST: POP P,T
DODEP: SKIPN CDEPPN ;ARE WE DEPOSITING A DEFINITION?
JRST DODEP1
PUSH P,T ;YES, SAVE T
MOVE T,CDEPPN ;GET DEPOSIT LIST POINTER
PUSH P,TT ;SAVE TT
PUSH P,TTT ;SAVE TTT
DODLOP: MOVE TT,1(T) ;GET BYTE POINTER
TLNE TT,770000 ;END OF WORD?
JRST DOTP4 ;NO
GETFS (TTT)
SETZM (TTT) ;CLEAR POINTER TO NEXT
SETZM 1(TTT) ;AND DATA
HRRM TTT,-1(TT) ;DEPOSIT POINTER HERE
HRR TT,TTT
DOTP4: IDPB C,TT ;DEPOSIT CHR.
MOVEM TT,1(T) ;DEPOSIT NEW POINTER
HRRZ T,(T) ;GET NEXT THING IN DEPOSIT LIST
JUMPN T,DODLOP ;LOOP IF MORE DEPOSITING TO DO
POP P,TTT
POP P,TT
POP P,T
DODEP1: TLNN IGNORE ;DOING DEFINITION OR FALSE PART OF ;F?
TRNN C,600 ;NO, BITS?
JRST CPOPJ1
CAIN C,":"+200 ;IS THIS ;R0?
JRST ITRETX ;YES
MOVEM C,1(P)
ANDI C,177
CAIN C,";" ;OR SEMI COLON
JRST DOSEMI ;WILL POPJ
CAIE C,12 ;DON'T PUT BITS BACK ON LF!
MOVE C,1(P)
JRST CPOPJ1 ;IT'S A CHARACTER
ITRETX: PUSHJ P,PUSHIT
PUSHJ P,ITRETZ
PUSHJ P,POPIT
POPJ P, ;TELL HIM TO ASK AGAIN
DOSEMI: PUSHJ P,PUSHIT
PUSHJ P,ITSEM ;DO THE SEMICOLON THING
PUSHJ P,POPIT
POPJ P,
GETMAC: TLNN C,770000 ;END OF WORD?
JRST GETBYT
GOTBYT: ILDB C,INPNT ;GET CHR.
JUMPN C,DODEP
ENDMAC: MOVEI C,":"+200 ;GET A ;R0 AT END
JRST DODEP
GETBYT: HRR C,-1(C)
TRNN C,-1 ;END OF LIST?
JRST ENDMAC ;YES, GENERATE <CTRL>:
MOVEM C,INPNT ;DEPOSIT INCREMENTED POINTER
JRST GOTBYT
;"D"
ITDEF: PUSHJ P,ITMAC ;STARTS JUST LIKE NAMED MACRO
HRRZ T,MACPNT
ITSKPF: TLOE IGNORE ;START IGNORING
POPJ P, ;ALREADY IGNORING, LEAVE
PUSH P,T
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/IGNORING!
/]
ITLOP1: SETZ B, ;KEEP LEVEL HERE
ITLOOP: PUSHJ P,GETLN
JRST ITLOOP ;GET AGAIN
CAIN C,":"+200 ;ITZERO?
JRST ITPOP ;UP A LEVEL
TRZN C,600 ;ANY BITS?
JRST ITLOOP
CAIE C,";" ;YES, IS IT SEMI COLON?
JRST ITLOOP ;NO
PUSHJ P,MREADN ;GET ARG AND COMMAND
TRZ C,600 ;CLEAR BITS
CAIN C,"R"
JRST ITPOPA
CAIN C,"S" ;THIS ENDS IT ALL
JRST ITPOP
CAIE C,"M" ;THESE 3 HAVE MATCHING ;R'S OR $:'S
CAIN C,"P"
AOJA B,ITLOOP
CAIN C,"D"
AOJA B,ITLOOP
JRST ITLOOP
ITPOPA: PUSHJ P,READN ;EAT ARG TO ;R
ITPOP: SOJGE B,ITLOOP
PUSHJ P,ITRETZ ;THIS WILL POP UP A LEVEL
HRRZ TT,MACPNT
CAML TT,(P) ;HAVE WE PASSED WHERE WE WANTED TO STOP?
JRST ITLOP1 ;NO
POP P,(P) ;POP OFF LEVEL
TLZ IGNORE ;YES, STOP IGNORING
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/END IGNORING!
/]
POPJ P,
;"F"
ITFLAG: PUSHJ P,READN ;GET LEVEL TO RETURN UP TO
MOVE TT,T
IMULI TT,5 ;MULT LEVEL BY 5
MOVE T,MACPNT ;GET MACRO PDL POINTER
SUB T,TT ;BACK UP CORRECT NUMBER OF LEVELS
ANDI T,-1
CAIG T,MACPDL ;TOO FAR?
JRST [ADDI T,5 ;YES
JRST .-1]
PUSH P,T ;SAVE POINTER TO MACPDL
MOVE TT,C
CAIN TT,"-"
JRST [ PUSHJ P,GETWRD
JRST WASNOT]
MOVE A,[POINT 6,T]
SETZ T,
PUSHJ P,ISCHRX
WASNOT: EXCH TT,C
CAIE TT,12
JRST ERRXT
MOVSI TT,-FLGLEN ;TABLE LENGTH
CAME T,FLGNAM(TT)
AOBJN TT,.-1
POP P,T
JUMPGE TT,PERRET ;ERROR RETURN IF FLAG NOT FOUND
HRRZ TT,TT ;CLEAR COUNT IN LEFT HALF
XCT FLGTAB(TT)
TDZA TT,TT ;FALSE
SETO TT, ;TRUE
CAIN C,"-" ;DID HE TYPE  ?
SETCA TT, ;FLAG YES
JUMPE TT,CPOPJ ;NOOP IF NOT TRUE
JRST ITSKPF ;AND START IGNORING
ERRXT: POP P,(P)
JRST ERRX
DEFINE FLGMAC(A,B,C)
<
IFIDN<B><BOTH>< <SIXBIT/A/> >
IFIDN<B><D><MD,<<SIXBIT/A/>> >
IFIDN<B><PC><MPC,<<SIXBIT/A/>> >
>
FLGNAM: FLAGS ;MACRO FROM DATA FILE
FLGLEN__.-FLGNAM
;HERE ARE SOME FLAG TESTING ROUTINES
DEFINE FLGMAC(A,B,C)
<
IFIDN<B><BOTH>< IFIDN<C><><SKIPN A;>C >
IFIDN<B><D><MD,< IFIDN<C><><SKIPN A;>C> >
IFIDN<B><PC><MPC,< IFIDN<C><><SKIPN A;>C> >
>
FLGTAB: FLAGS ;COMMAND TO EXECUTE FOR FLAG TEST
;ROUTINE FOR CLOSES FLAG
CLTEST: PUSH P,A
PUSHJ P,GETCLS
CAIA
AOS -1(P) ;THERE IS A CLOSEST, SKIP
POP P,A
POPJ P,
;ROUTINE FOR RITEON FLAG
ROTEST: PUSH P,T
PUSH P,A
MOVEI T,1
LSH T,@MODE
TDNN T,[MD,<1BTXTM!1EDTM!1EDTTM!1EDTPM!>1SETM!1BODM!1PNTM!1TXTM]
JRST ROTST1
PUSHJ P,GETCLS
JRST ROTST1
MOVE T,1(A)
TDZ T,[1,,1]
CAMN T,CURSE
AOS -2(P)
ROTST1: POP P,A
POP P,T
POPJ P,
;ROUTINE FOR EXPR FLAG
FEXPR: PUSHJ P,PUSHIT
PUSHJ P,EXPSET ;READ AND TEST EXPRESSION
JFCL ;GIVE FALSE RETURN ON ERROR
JRST [ PUSHJ P,POPIT ;FALSE
POPJ P,]
PUSHJ P,POPIT ;TRUE
JRST CPOPJ1
;SEMI COLON DISPATCH RENMAC DELMAC PMACRO
ITSEM: SKIPN T,CDEPPN ;ARE WE DEPOSITING A DEFINITON?
JRST NOMFIX ;NO, NOTHING TO DO
DOFIX: LDB C,1(T) ;GET SEMI-COLON
TRO C,600 ;MAKE SURE IT ALWAYS LOOKS LIKE A MACRO COMMAND
DPB C,1(T) ;AND PUT IT BACK
HRRZ T,(T)
JUMPN T,DOFIX ;DO SOME MORE?
NOMFIX: PUSHJ P,MREADN ;GET # AND CHAR WHICH FOLLOWS
SEMCAL: TRZ C,600 ;IGNORE CONTROL BITS
CAIL C,"A"+40
SUBI C,40 ;CONVERT LC TO UC
;HERE ARE THE COMMANDS WHICH DON'T PUSH THE MACRO PDL.
CAIN C,"R"
JRST ITRET
CAIN C,"O"
JRST ITOUT
CAIN C,"F"
JRST ITFLAG
CAIN C,"S"
JRST ITSTOP
;HERE ARE THE COMMANDS WHICH DO PUSH THE MACRO PDL.
HLRE T,MACPNT
CAML T,[-5] ;ENOUGH ROOM FOR ANOTHER MACRO LEVEL?
JRST [ OUTSTR[ASCIZ/
****** MACRO PDL OVERFLOW ******
/]
JRST ITSTOP]
CAIN C,"M" ;IS IT M?
JRST ITMAC ;YES
CAIN C,"P"
JRST ITPNT
CAIN C,"D"
JRST ITDEF
CAIN C,"T"
JRST ITTYP
CAIN C,"U"
JRST ITOOPS
CAIN C,"C"
JRST ITCAL
CAIN C,"A"
JRST ITARG
CAIN C,"N"
JRST ITSARG
CAIN C,"L"
JRST ITLET
CAIN C,"V"
JRST ITVAR
CAIN C,"E"
JRST ITEVAL
CAIN C,"X"
JRST ITEXPR
CAIN C,"#"
JRST ITDEQU
CAIN C,"="
JRST ITEQU
CAIN C,"H"
JRST ITVAR0
CAIN C,"I"
JRST ITIN
CAIN C,"Y"
JRST ITYANK
CAIN C,"G"
JRST ITLOWG
CAIN C,"^"
JRST ITCTRL
JRST PERRET
RENMAC: PUSHJ P,ITGET
JRST NXMAC
HRLM E,(P)
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE NEW MACRO NAME./]
PUSHJ P,ITGETA
JRST ITMOK
TLNE M,DSKACT!MACACT
JRST PERRET
OUTSTR[ASCIZ/SORRY, ALREADY IN USE!
/]
POPJ P,
UNSAVM: SKIPA F,[ANDCAM T,(E)]
SAVMAC: MOVE F,[IORM T,(E)]
PUSHJ P,ITGET
JRST NXMAC
MOVSI T,MSAVE
XCT F ;SET OR CLEAR BIT
POPJ P,
ITMOK: HLRZ E,(P)
HRRZ B,1(E) ;GET OLD NAME
HRRM D,1(E) ;STORE NEW ONE
JRST PUTFS
DELMAC: HRRZ T,MACPNT
CAIL T,MACPDL
JRST NINMAC
PUSHJ P,ITGET ;GET MACRO
JRST NXMAC
HRRZ T,MACPNT
CAIL T,MACPDL
JRST NINMAC
;ENTER HERE WITH E:MACRO TO DELETE, C:PREVIOUS MACRO
DELMC1: HRRZ T,(E)
HRRM T,(C) ;LINK HIM OUT
HRRZ B,1(E)
PUSHJ P,PUTFS ;GIVE BACK NAME
HLRZ B,1(E)
PUSHJ P,PUTFS ;GIVE BACK BODY
MOVE TT,E ;SAVE COPY OF MACRO HEADER
FSTRET(E) ;GIVE BACK HEADER
MOVE T,MODE
CAIN T,MALTM
CAME TT,REMMAC ;DID WE JUST DELETE MACRO WE WERE EDITING?
POPJ P,
TRO MCHG
MOVE T,MODALT
JRST CHNGMD ;LEAVE MACRO ALTER MODE
DELMCS: HRRZ T,MACPNT
CAIL T,MACPDL
JRST NINMAC
MOVEI E,MDPNT
DLMCS1: MOVE C,E ;SAVE PREVIOUS
DLMCS2: HRRZ E,(C) ;GET NEXT
JUMPE E,CPOPJ ;DONE IF NO MORE
HRRZ T,1(E) ;GET MACRO NAME
PUSHJ P,OUTTXT ;TYPE IT
HRL E,C
PUSHJ P,YORN
POPJ P, ;QUIT ON ALT
JRST DLMCS1 ;GET NEXT IF NO
HLRZ C,E
HRRZ T,MACPNT
CAIL T,MACPDL
JRST NINMAC ;IF HE STARTED A MACRO, BLOW HIM OUT OF THE WATER
PUSHJ P,DELMC1 ;DELETE IF YES
JRST DLMCS2 ;GET NEXT FROM C THIS TIME
NINMAC: TLNE M,DSKACT!MACACT
JRST PERRET
OUTSTR[ASCIZ/NOT INSIDE MACRO!!
/]
POPJ P,
MREADN: PUSHJ P,GETCHR
SETZ A,
CAIE C,"-"
JRST MREADP
PUSHJ P,MREADM
MOVN A,A
POPJ P,
MREADM: SETZ A,
MREADO: PUSHJ P,GETCH
JRST MREADO
MREADP: CAIL C,"0"
CAILE C,"9"
POPJ P,
IMULI A,=10
ADDI A,-"0"(C)
JRST MREADO
PMACRO: PUSHJ P,ITGET ;WHICH MACRO
JRST NXMAC
TVOFF
HLRZ E,1(E) ;GET POINTER TO BODY
ADD E,[POINT 9,1]
PMAC1: TLNE E,770000 ;END OF WORD?
JRST PMAC2
HRR E,-1(E)
TRNE E,-1 ;END OF MACRO?
JRST PMAC2 ;NO
OUTSTR[ASCIZ/
/]
TVON
POPJ P,
PMAC2: ILDB C,E ;GET CHAR
JUMPE C,PMAC1
NOSKEY,< TRC C,600
TRCN C,600 ;CTRL META?
JRST [ ANDI C,177 ;YES
OUTCHR[CTLMTA]
JRST PMAC3]
TRZE C,200 ;CTRL?
OUTCHR[CTRL]
TRZE C,400 ;META?
OUTCHR[META]
PMAC3:
>;NOSKEY
SKEY,< MOVE T,C
LSH T,-7
CAIA
OUTCHR["$"]
SOJGE T,.-1
>;SKEY
CAIN C,12
JRST [ OUTSTR[ASCIZ/
/]
JRST PMAC1]
SKEY,< CAIGE C,40
JRST [ CAIE C,11
CAIN C,ALTMOD
JRST .+1
ADDI C,100
OUTCHR["^"]
JRST .+1]
>;SKEY
OUTCHR C
JRST PMAC1
;"P" "V"
ITPNT: HRRZ T,MACPNT
CAIGE T,MACPDL ;IS THIS TOP LEVEL?
JRST ITLAST ;YES DO ";MLAST"
MOVE T,MACPNT ;GET MACRO PDL POINTER
TLNE M,MACACT
JRST GOTINP ;YES
SKIPE B,CDEPPN ;ARE WE ALREADY DEPOSITING?
JRST GOTDEP ;YES
GETFS (B) ;NO
SETZM (B) ;CLEAR "TO NEXT" POINTER
HRRZM B,CDEPPN ;DEPOSIT DEPOSIT LIST POINTR
GETFS (C)
HRLM C,(B) ;DEPOSIT POINTER TO START OF CHAIN
SETZM (C)
IMCON1: SETZM 1(C)
HRLI C,441100 ;MAKE A BYTE POINTER
ADDI C,1
MOVEM C,1(B) ;DEPOSIT POINTER
PUSH T,B ;PUSH POINTER TO THING TO REMOVE
SKIPA
GOTDEP: PUSH T,[0] ;DON'T REMOVE ANYTHING
SETZM BRKCHR
PUSH T,[0] ;MAKE PLACE TO SAVE CDEPPN LATER ON
PUSH T,1(B) ;PUSH POINTER TO START OF LOOP
GOTRET: PUSH T,[0] ;MAKE PLACE TO SAVE COUNT
PUSH T,[-1] ;MAKE PLACE TO SAVE POINTER TO END OF LOOP
GOTRTV: MOVEM T,MACPNT ;SAVE PDL POINTER
TLNE M,DSKACT!MACACT
POPJ P,
HRRZS T
SUBI T,MACPDL-1
IDIVI T,5
OUTSTR[ASCIZ/
ENTERING MACRO LEVEL /]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/.
/]
POPJ P,
GOTINP: PUSH T,[0] ;DON'T REMOVE ANYTHING
SETZM BRKCHR
PUSH T,[0] ;MAKE PLACE TO SAVE CDEPPN LATER
PUSH T,INPNT ;SAVE CURRENT INPUT POINTER AS LOOP START POINT
JRST GOTRET
;VARIABLE INPUT, TTY INPUT FIRST TIME THROUGH LOOP
ITVAR: PUSHJ P,READN ;READ LEVEL NUMBER
MOVE TT,T
IMULI TT,5 ;MULT LEVEL BY 5
MOVE T,MACPNT ;GET MACRO PDL POINTER
SUB T,TT ;BACK UP CORRECT NUMBER OF LEVELS
ANDI T,-1
CAIG T,MACPDL ;TOO FAR?
JRST [ ADDI T,5 ;YES
TLNN M,MACACT!DSKACT
OUTSTR[ASCIZ/TRUNCATING MACRO LEVEL!
/]
JRST .-1]
HRRZ TT,MACPNT ;CHECK IF ALL INTERVENING MACROES ARE IN FIRST TIME
VARCHK: SKIPE -1(T) ;FIRST TIME AT THIS LEVEL?
JRST ITCAL ;NO, DO ";C"
ADDI T,5
CAIG T,(TT) ;CHECK ALL INTERVENING MACROES YET?
JRST VARCHK ;NO
PUSHJ P,ITMACS
MOVE T,MACPNT ;GET MACRO PDL POINTER
GETFS (B)
HRRZ B,B
PUSH T,B ;THING TO RETURN LATER
SETZM BRKCHR
PUSH T,CDEPPN ;WE DON'T NEED TO DEPOSIT NEW DEFINITION (WILL ALWAYS BE TYPED)
HRRZM B,CDEPPN ;.....
GETFS (C)
HRLM C,1(E) ;PUT IN LINK TO TEXT
HRLZM C,(B) ;...
SETZM (C)
HRROS (C) ;MARK AS MACRO (SO IT WON'T GET DELETED)
SETZM 1(C)
HRLI C,441100 ;MAKE A BYTE POINTER
ADDI C,1
MOVEM C,1(B) ;DEPOSIT POINTER
PUSH T,1(B) ;LOOP START LOC
PUSH T,[0] ;MAKE PLACE FOR COUNT
PUSH T,INPNT ;SAVE CURRENT INPUT POINTER
SETZM INPNT ;TAKE INPUT FROM TTY
PUSHJ P,RSTMAC
PUSHJ P,GOTRTV
TLNE M,DSKACT ;DISK INPUT ACTIVE?
POPJ P, ;YES
OUTSTR[ASCIZ/TYPE VALUE OF /]
HRRZ T,1(E)
PUSHJ P,OUTTXT
OUTSTR[ASCIZ/
/]
POPJ P,
;":" "R" "S"
ITRETZ:
; TLNN M,MACACT!DSKACT ;DISK OR MACRO ACTIVE?
; OUTSTR[ASCIZ/
;/] ;NO, ECHO CRLF
MOVE A,MACPNT
HRRZ B,A
CAIG B,MACPDL
POPJ P,
SETOM -1(A) ;MAKE COUNT BE OUT NOW
JRST ITSTP2
ITRET: PUSHJ P,READN ;READ NUMBER OF TIMES TO ITERATE
CAIE C,"#" ;THIS SPECIAL CHAR?
JRST ITRTLF ;NO, LOSE
JUMPN T,INNERR ;ERROR IF NUMBER PRECEEDING
MOVE T,FNDNUM ;USE COUNT OF THINGS FOUND
PUSHJ P,GETLIN ;GET LF
ITRTLF: CAIE C,12 ;MUST BE LF
JRST INNERR ;LOSE
MOVE A,MACPNT ;GET PDL POINTER
HRRZ B,A ;GET ADDRESS PART
CAIG B,MACPDL ;BACK AT START?
POPJ P, ;YES, LEAVE
SKIPGE B,-1(A) ;GET COUNT. ANY COUNT YET?
JRST DONBEF ;YES, THIS IS NOT THE FIRST TIME THROUGH THIS LOOP
MOVN B,T ;NEGATE COUNT
HRLZ B,B ;DEPOSIT COUNT IN LT HF, # OF TIMES THROUGH LOOP IN RT HF
MOVEM B,-1(A) ;DEPOSIT
ITSTP2: MOVE C,INPNT ;GET CURRENT INPUT POINTER
MOVSI D,1
TDNE D,(A) ;ALREADY SAVED?
MOVEM C,(A) ;NO, SAVE
MOVE T,CDEPPN ;GET DEPOSIT LIST POINTER
SKIPN -3(A)
MOVEM T,-3(A) ;SAVE IT
SETZM CDEPPN ;DON'T DEPOSIT WHILE LOOPING
DONBEF: TLNE IGNORE ;ARE WE TRYING TO IGNORE?
JRST DONDON ;YES, MAKE BELIEVE COUNT IS OUT
MOVE B,-1(A) ;GET COUNT
AOBJP B,DONDON ;INC COUNTS, DONE?
MOVEM B,-1(A) ;NO, STO IT
MOVE C,-2(A) ;GET POINTER TO START OF LOOP
MOVEM C,INPNT ;TAKE INPUT FROM THERE
RSTMAC: SKIPE INPNT
TLOA M,MACACT
TLZN M,MACACT ;TURN OFF, AND IF WAS ALREADY OFF
JRST DSPSET ;JUST CALC STATE OF DSPACT
PUSHJ P,DSPSET ;ELSE CALC DSPACT
JRST ENDDSP ;AND CHECK DISPLAY
DONDON: POP A,INPNT ;RESTORE INPUT POINTER
PUSHJ P,RSTMAC ;FIX BIT
POP A,TT ;THROW AWAY COUNT
POP A,TT ;SAVE LOOP-START POINTER FOR CHECK LATER
POP A,CDEPPN ;RESTORE DEPOSIT LIST POINTER
HRRZS CDEPPN
POP A,B ;GET THING-TO-THROW-AWAY POINTER
HRRZ B,B ;CLEAR FLAGS AND BRKCHR
MOVEM A,MACPNT ;STORE MACRO PDL POINTER
HRRZ T,A
CAIGE T,MACPDL
TDZA T,T
HLRZ T,-4(T)
ANDI T,177
MOVEM T,BRKCHR ;RESTORE BRKCHR FROM MACRO NOW IN FORCE (IF ANY)
JUMPE TT,NOLEVP ;IF NOT LOOP START POINTER, DON'T PRINT LEVEL
TLNE M,DSKACT!MACACT
JRST NOLEVP
HRRZ T,A
SUBI T,MACPDL-1
IDIVI T,=5
ADDI T,1
OUTSTR[ASCIZ/LEAVING MACRO LEVEL /]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/.
/]
NOLEVP: JUMPE B,CPOPJ ;NOTHING TO THROW AWAY
MOVEI A,CDEPPN ;GET DEPOSIT LIST POINTER
DONDN1: HRRZ D,(A) ;GET POINTER
JUMPE D,DARN2
CAMN B,D ;SAME?
JRST DONDN2 ;YES
MOVE A,D ;NO, TRY NEXT
JRST DONDN1
DONDN2: HRRZ C,(B) ;GET POINTER TO NEXT
HRRM C,(A) ;DEPOSIT POINTER AROUND
DARN2: MOVSS (B)
HRRZ C,(B) ;GET FLAG
HLRZ C,(C)
JUMPE C,PUTFS ;IF NOT A MACRO, RETURN WHOLE THING TO FS
FSTRET (B) ;OTHERWISE RETURN ONLY FIRST THING
POPJ P,
ABMAC: MOVE T,MACPNT
CAMG T,[-MPDLEN,,MACPDL]
POPJ P,
GETFS(B)
SETZM (B)
MOVE T,[BYTE(9)";"+600,"S"]
MOVEM T,1(B)
TLZ IGNORE
JRST ITLET2
ITSTOP: MOVE A,MACPNT
HRRZ B,A
TLZ IGNORE
CAIG B,MACPDL
POPJ P, ;NOT DOING ANY MACRO HACKING NOW
SETOM -1(A) ;TO COUNT OUT THIS TIME
PUSHJ P,ITSTP2 ;FAKE A ;R
JRST ITSTOP ;& TRY AGAIN AT NEXT LEVEL
;"M" "C" , STUFF SUBRS
;COME HERE TO GENERATE STOP ON ERROR DURING MACRO
ITERR: OUTSTR[ASCIZ/DOING ;T
/]
MOVEI B,0
JRST MACRT1
ITMACS: PUSHJ P,TREADV ;GET MACRO NAME
MOVE D,B ;HOLD POINTER TO IT
;ENTER HERE WITH MACRO NAME IN D
ITMACI: SKIPE 1(D)
JRST ITMLP0
MOVE E,[ASCIZ/NIL/]
MOVEM E,1(D)
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NAMING MACRO AS NIL
/]
ITMLP0: MOVEI E,MDPNT ;GET POINTER TO MACROS
ITMLP1: HRRZ E,(E) ;GET POINTER TO MACRO
JUMPE E,NOMOTM ;NONE? ( OR NO MORE?)
HRRZ A,1(E) ;GET NAME POINTER
MOVE B,D ;GET OTHER NAME POINTER
PUSHJ P,TXTMAT ;SEE IF THE SAME
JRST ITMLP1 ;NO, TRY NEXT
HLRZ B,1(E) ;SAME, GET POINTER TO BODY
PUSHJ P,PUTFS ;RETURN TO FREE STORAGE
HRRZ B,1(E) ;GIVE BACK OLD NAME
HRRM D,1(E) ;NOT NEW (HIGHER UPS LOOK AT IT)
JRST PUTFS ;RETURN TO FREE STORAGE
NOMOTM: GETFS (E) ;GET FREE STORAGE
MOVE B,MDPNT ;GET MACRO POINTER
MOVEM B,(E) ;LINK NEW ONE IN
HRRM D,1(E) ;PUT IN NAME
HRRZM E,MDPNT ;(LINK IN)
POPJ P,
ITLAST: PUSH P,A ;SAVE ARG
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/;MLAST/]
GETFS(D)
SETZM (D)
MOVE T,[ASCIZ/LAST/]
MOVEM T,1(D)
PUSHJ P,ITMACI
JRST ITMAC0
ITMAC: PUSH P,A ;SAVE ; ARG
PUSHJ P,ITMACS
MOVE B,1(D) ;GET FIRST WORD OF NAME
CAME B,[ASCIZ/INIT/] ;THIS MACRO GETS AUTOMATIC SMACRO
JRST ITMAC0
MOVSI B,MSAVE
IORM B,(E) ;MARK IT SAVED
ITMAC0: MOVE T,MACPNT ;GET MACRO PDL POINTER
POP P,A
CAIE A,1 ;1 WILL SET MSAVE
TDZA A,A
MOVSI A,MSAVE
IORM A,(E)
GETFS (B)
MOVE F,CDEPPN ;GET DEPOSIT LIST POINTER
MOVEM F,(B) ;LINK NEW ONE IN
HRRZM B,CDEPPN ;.....
GETFS (C)
HRLM C,1(E) ;PUT IN LINK TO TEXT
HRLM C,(B) ;...
SETZM (C)
HRROS (C) ;MARK AS MACRO (SO IT WON'T GET DELETED)
JRST IMCON1
ITGET: TLNN M,DSKACT!MACACT ;INSIDE A MACRO?
OUTSTR [ASCIZ /TYPE MACRO NAME./]
ITGETA: PUSHJ P,TREADV ;GET MACRO NAME
MOVE D,B ;HOLD POINTER
MOVEI E,MDPNT ;GET POINTER TO LIST OF MACROS
ITCLP1: MOVE C,E ;SAVE PREVIOUS HERE
HRRZ E,(E) ;GET POINTER TO MACRO
JUMPE E,CPOPJ
HRRZ A,1(E) ;GET MACRO NAME
MOVE B,D ;GET TYPED NAME
PUSHJ P,TXTMAT ;SAME?
JRST ITCLP1 ;NO, LOOP
MOVE B,D ;YES
PUSHJ P,PUTFS ;RETURN TYPED NAME TO FS
HLRZ B,1(E) ;GET BODY POINTER
ADD B,[XWD 441100,1];MAKE BYTE POINTER
JRST CPOPJ1
NXMAC: MOVE B,D
PUSHJ P,PUTFS
TLNE M,DSKACT!MACACT
JRST PERRET
OUTSTR [ASCIZ /NO SUCH MACRO
/]
POPJ P,
MACCAL: SKIPN E,MDPNT
JRST CPOPJ1 ;LOSE
MACCL1: HRRZ A,1(E)
MOVE D,1(A)
CAMN D,@(P) ;SAME AS ARG?
JRST MACCL2 ;YES
HRRZ E,(E)
JUMPN E,MACCL1
JRST CPOPJ1
MACCL2: AOS (P) ;SKIP ARG
TRNN TFLG ;CHECK READIN BIT?
JRST MACCL3
HLRZ B,(E) ;GET BITS
TRNN B,MACTMP ;JUST READ IN?
POPJ P, ;NO, SKIP IT
MACCL3: HLRZ B,1(E)
ADD B,[POINT 9,1]
JRST MACRT1 ;CALL IT
ITCAL: PUSHJ P,ITGET
JRST NXMAC
MACRT1: MOVE T,MACPNT ;GET MACRO PDL POINTER
PUSH T,[0] ;DON'T RETURN ANYTHING TO FREE STORAGE AT END
SETZM BRKCHR
MACRT2: PUSH T,CDEPPN ;SAVE CDEPPN
HRROS (T)
SETZM CDEPPN
PUSH T,B ;SAVE START POINTER
PUSH T,[0] ;MAKE PLACE FOR COUNT
PUSH T,INPNT ;SAVE CURRENT INPUT POINTER
MOVEM B,INPNT ;TAKE INPUT FROM MACRO BODY
MOVEM T,MACPNT ;STORE MACRO PDL POINTER
JRST RSTMAC
;CALL WITH POINTER TO 9 BIT TEXT IN A
;BYTE POINTER TO END OF 9 BIT TEXT IN TT
ITSTUF: PUTBYT 200+":" ;ADD <CTRL><COLON> AT END
TLNN M,MACACT!DSKACT
OUTSTR[ASCIZ/TYPE TEXT MACRO NAME./]
PUSHJ P,ITMACS
MOVE A,SETSTR
HRROS (A) ;MARK AS PERMANENT
HRLM A,1(E) ;STUFF AWAY TEXT POINTER
POPJ P,
;ENTER HERE WITH 7 BIT MACRO NAME IN D
;AND 9 BIT MACRO IN A
ITMAKE: PUSH P,A
PUSHJ P,ITMACI ;FIND OLD AND DELETE, OR JUST MAKE NEW BLOCK
POP P,A
HRROS (A)
HRLM A,1(E) ;PUT IN MACRO BODY
TLNE M,DSKACT!MACACT
POPJ P,
MOVE T,D
PUSHJ P,OUTTXT ;PRINT MACRO NAME
OUTSTR[ASCIZ/
/]
POPJ P,
;CALL WITH BYTE POINTER IN T, RETURNS CHAR IN C
GETTT: TLNE T,760000
JRST GETTT1
HRR T,-1(T)
TRNN T,-1
POPJ P,
GETTT1: ILDB C,T
JUMPN C,CPOPJ1
JRST GETTT
;SETUP OUTPUT STREAM TO STRING
;RETURNS
;A = STRING HEAD
;TT = POINTER (TTPTR)
SETTT7: PUSHJ P,SETTT0
TLO TT,(<POINT 7,0>)
MOVEM TT,TTPTR
MOVE A,SETSTR
POPJ P,
SETTT0: MOVEM A,SETSTR
GETFS(A)
SETZM (A)
SETZM 1(A)
MOVE TT,[PUSHJ P,PUTTTC]
MOVEM TT,PUTCHR
MOVEI TT,1(A)
EXCH A,SETSTR
POPJ P,
SETTT: PUSHJ P,SETTT0
TLO TT,(<POINT 9,0>)
MOVEM TT,TTPTR
POPJ P,
;CALL WITH NUM IN B , AFTER SETTING UP WITH SETTT
PUTTTN: IDIVI B,=10
HRLM C,(P)
JUMPE B,.+2
PUSHJ P,PUTTTN
HLRZ C,(P)
MOVEI TTT,60(C)
;CALL WITH CHAR IN TTT, POINTER SET UP BY SETTT
PUTTTC: EXCH TT,TTPTR
TLNE TT,760000
JRST PUTTT1
PUSH P,TTT
GETFS(TTT)
HRRM TTT,-1(TT)
SETZM 1(TTT)
SETZM (TTT)
HRR TT,TTT
POP P,TTT
PUTTT1: IDPB TTT,TT
EXCH TT,TTPTR
POPJ P,
;"U" "T" "L" "^" "A" "N" "#" "="
ITOOPS: SKIPE INPNT ;IF INPUTTING FROM MACRO,
POPJ P, ;THIS IS A NOOP
;ELSE IT IS A ;T
ITTYP: TLNN M,DSKACT
OUTSTR [ASCIZ /TYPE ARGUMENT./]
MOVEI B, ;TAKE INPUT FROM TYPING
JRST MACRT1
ITDEQU: PUSHJ P,GETCHR
SKIPN T,L2N(C) ;ANY LOCATION CONVERSION FOR LETTER?
HRREI T,-100(C) ;IF NOT LETTER, DO ITEQU
MOVEI C,"#"
JRST ITLET0
ITEQU: PUSHJ P,GETCHR
HRREI T,-100(C) ;GET CODE FOR LETTER AS NUMBER IN STANDARD FORMAT
MOVEI C,"="
JRST ITLET0
ITLET: PUSHJ P,SREADN ;READ # ARG
CAIN C,12
JRST ITLETA
CAIE C,"D"
JRST INNERR
JUMPN T,INNERR
PUSHJ P,SREADN
CAIE C,12
JRST INNERR
JUMPLE T,ITLETA
CAMG T,MAXN2L ;IN LETTER RANGE?
SKIPA TT,N2L(T) ;USE THIS
ITLETA: MOVEI TT,100(T) ;CONVERT TO CHARACTER
PUSHJ P,MACLET ;MAKE LETTER MACRO
MOVEI C,"L"
JRST ITLET1 ;AND MERGE WITH IT ARG
ITCTRL: PUSHJ P,GETCHR ;GET CHARACTER
CAIL C,"A"+40
CAILE C,"Z"+40
CAIA
SUBI C,40 ;CONVERT LC TO UC
CAIL C,100 ;IF NOT ALREADY BELOW 100
SUBI C,100 ;MAKE IT A CONTROL CHARACTER
ANDI C,177 ;NO CONTROL BITS PLEASE
MOVE TT,C
PUSHJ P,MACLET ;MAKE THE MACRO
MOVEI C,"^"
JRST ITLET1
ITSARG: PUSHJ P,ARGSET ;READ ARGS
POPJ P, ;ERROR
PUSHJ P,SMACNM ;SIGNED NUMBER
MOVEI C,"N"
JRST ITLET1
ITARG: PUSHJ P,ARGSET ;READ ARGS
POPJ P, ;ERROR
MOVEI C,"A"
ITLET0: PUSHJ P,MACNUM ;CREATE TEXT NUMBER FROM IT
ITLET1: TLNE M,DSKACT!MACACT
JRST ITLET2
OUTSTR[ASCIZ/END ;/]
OUTCHR C
OUTSTR[ASCIZ/
/]
ITLET2: HRRZ T,(B) ;GET POINTER TO TEXT
HRLM T,(B) ;DUPLICATE IN LEFT HALF SO THAT LIST REMOVER AT
;END OF ITRET WILL RETURN IT TO FREE STORAGE PROPERLY
MOVE T,MACPNT ;GET MACRO PDL POINTER
HRRZ B,B
PUSH T,B ;RETURN TO FREE STORAGE AT END
SETZM BRKCHR
PUSH T,CDEPPN ;SAVE DEPOSIT LIST
HRROS (T) ;MARK AS SAVED
PUSH T,[0] ;PUSH ZERO AS START BYTE POINTER
PUSH T,[-1,,0] ;1 AS COUNT (DO ONCE) LOOP COUNT OF 0
PUSH T,INPNT ;SAVE INPUT POINTER
SETZM CDEPPN ;DON'T DEPOSIT
ADD B,[XWD 441100,1] ;MAKE BYTE POINTER
MOVEM B,INPNT ;TAKE INPUT FROM THERE
PUSHJ P,RSTMAC
MOVEM T,MACPNT
POPJ P,
ITVAR0: TLNN M,DSKACT!MACACT
SKEY,< OUTSTR [ASCIZ/VARIABLE NAME.
^/]>
NOSKEY,< OUTSTR[ASCIZ/VARIABLE NAME.
/]>
PUSHJ P,VARNM ;GET VARIABLE NAME
CAIE C,12 ;MUST END WITH <LF>
JRST INNERR
PUSHJ P,VARFND ;LOOKUP NAME
JRST VARN99 ;NOT FOUND, ERROR
HLRZ T,(E) ;GET PTR TO EXPANSION
PUSHJ P,SETTT ;COPY INTO A 9-BIT STRING
MOVE A,SETSTR
JUMPE T,ITVAR1
ADD T,[XWD 440700,1];MAKE A BYTE PTR TO TEXT
PUSHJ P,GETTT
JRST ITVAR1
PUTBYT (C)
JRST .-3
ITVAR1: MOVE B,A
PUTBYT 200+":"
MOVEI C,"H"
JRST ITLET1
ARGSET: HRRZ G,MACPNT ;SETUP INTIAL MACPDL POINTER
PUSHJ P,SREADN ;GET LEVEL # (OR INITIAL VALUE)
MOVE TT,T
CAIN C,12 ;NEW FORMAT?
JRST [ MOVEI T,1 ;ASSUME INC OF 1
JRST GOTANM]
CAIE C,","
JRST INNERR
PUSHJ P,SREADN
CAIN C,12
JRST GOTANM
MOVE TTT,T
PUSHJ P,READN
CAIE C,12 ;NOW IT MUST BE LF
JRST INNERR ;LOSE BIG
PUSHJ P,PDLCAL
MOVE T,TTT
GOTANM: HRRZ TTT,-1(G) ;GET LOOP COUNT
IMUL TTT,T ;MULT BY INC
ADD TT,TTT ;ADD TO INITIAL VALUE
MOVE T,TT ;PUT RESULT IN T
JRST CPOPJ1 ;SUCCESSFUL SCAN
PDLCAL: IMULI T,5 ;MULT LEVEL BY 5
SUB G,T ;BACK UP CORRECT NUMBER OF LEVELS
TRNLVL: CAILE G,MACPDL ;TOO FAR?
POPJ P,
ADDI G,5 ;YES
TLNN M,MACACT!DSKACT
OUTSTR[ASCIZ/TRUNCATING MACRO LEVEL!
/]
JRST TRNLVL
;"E" "X" "O" "I"
;"X"
ITEXPR: PUSHJ P,EXPSET
POPJ P, ;LOSE
TDZA T,T ;FALSE RETURN
SETO T, ;TRUE RETURN
MOVEM T,LSTEXP ;STORE HERE
GETFS (B)
HRRZ D,B ;HOLD POINTER
SETZM (D) ;CLEAR POINTER TO NEXT
SETZM 1(D) ;CLEAR DATA
ADD D,[XWD 441100,1] ;MAKE BYTE POINTER
MOVE T,[POINT 7,SIGBUF]
JRST ITEXP1
ITEXP2: PUSHJ P,PUTINL
ITEXP1: ILDB TT,T
JUMPN TT,ITEXP2
PUSHJ P,PUTRET
MOVEI C,"X"
JRST ITLET1
EXPSET: TLNN M,DSKACT!MACACT
SKEY,< OUTSTR[ASCIZ/TYPE EXPRESSION.
^/]>
NOSKEY,< OUTSTR[ASCIZ/TYPE EXPRESSION.
/]>
PUSHJ P,TREADX ;READ STRING
POPJ P, ;NULL OR ALTMODE
MOVE A,B
ADD A,[POINT 7,1]
MD,< SETZM DOVARS >
PUSHJ P,SIGSUB
JRST [
MD,< SETOM DOVARS >
OUTSTR [ASCIZ /ERROR IN EXPRESION(S):
/]
MOVE T,B
PUSHJ P,OUTTXT
OUTSTR [ASCIZ /
/]
JRST PUTFS] ;NOW GIVE BACK STRING
PUSHJ P,PUTFS ;GIVE BACK STRING
MD,< SETOM DOVARS >
MOVS T,SIGBUF
CAIE T,(<ASCIZ/0/>) ;DID EXPRESSION EVALUATE TO 0?
AOS (P)
JRST CPOPJ1
TREADX: PUSHJ P,GETLIN ;GET FIRST CHAR
CAIN C,12
POPJ P, ;IGNORE BLANK LINES
GETFS(B)
SETZM (B)
MOVSI T,(<ASCII/[/>)
MOVEM T,1(B)
MOVE T,B
ADD T,[POINT 7,1,6]
TREADY: PUSHJ P,TREADZ
PUSHJ P,GETLIN
CAIN C,ALTMOD
JRST PUTFS ;RETURN STRING IF ALTMODE
CAIE C,12
JRST TREADY
MOVEI C,"]"
AOS (P)
TREADZ: TLNE T,760000
JRST TREADW
GETFS(TT)
HRRM TT,-1(T)
HRR T,TT
SETZM (T)
SETZM 1(T)
TREADW: IDPB C,T
POPJ P,
;"E"
ITEVAL: PUSHJ P,TREADU ;READ MACRO NAME
POPJ P, ;ALTMODE
JFCL ;NULL, LET IT THROUGH
MOVE D,B ;SAVE POINTER TO NAME
PUSHJ P,SETTT
MOVE A,SETSTR
ITEVA1: PUSHJ P,GETLIN
CAIN C,600+":" ;CTRL META COLON?
JRST ITEVA2
PUTBYT (C)
JRST ITEVA1
ITEVA2: PUTBYT 200+":"
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
END ;E /]
JRST ITMAKE
ITOUT: PUSHJ P,TREAD
MOVE T,B
TLNN M,DSKACT!MACACT ;PRINT IF NOT TAKING INPUT FROM TTY
OUTSTR[ASCIZ/END ;O
/]
PUSHJ P,OUTTXT
OUTSTR[ASCIZ/
/]
JRST PUTFS
ITIN: TLNN M,DSKACT
OUTSTR[ASCIZ/TYPE ARGUMENT (END WITH CRLF).
/]
MOVE T,MACPNT
PUSH T,[400000,,0]
MOVEI B,
SETZM BRKCHR
JRST MACRT2
ITYANK: TLNN M,DSKFLG ;ANY I FILE?
JRST [ TLNN DSKACT!MACACT
OUTSTR[ASCIZ/SORRY, NO DSKIN FILE OPEN.
/]
POPJ P,]
PUSHJ P,GETCHR ;GET CHARACTER TO USE AS BREAK CHAR
ANDI C,177 ;NO CTRL OR META PLEASE
MOVEM C,BRKCHR
PUSHJ P,DSKCON ;CONTINUE DSK INPUT
HRLZ TT,C
MOVE T,MACPNT
PUSH T,TT ;SAVE BRKCHR ON STACK
MOVEI B,
JRST MACRT2 ;AND DO ;T
DSKCON: TLNN M,DSKFLG ;DOING DISK INPUT AT ALL?
POPJ P, ;NO
NOLAY,<TLO M,DSKACT>
LAY,<MOVSI C,DSKACT
TDO M,C
IORM C,LAYM
>;LAY
POPJ P,
ITLOWG: TLNN M,DSKACT!MACACT
SKEY,< OUTSTR[ASCIZ/TYPE STRING TO CONVERT.
^/]>
NOSKEY,< OUTSTR[ASCIZ/TYPE STRING TO CONVERT.
/]>
PUSHJ P,SETTT
ITLOW1: PUSHJ P,GETLIN
CAIN C,12 ;EOL?
JRST ITLOW2
CAIL C,100 ;CONVERT RANGE 100-137 TO 140-177
TRO C,40
PUTBYT (C)
JRST ITLOW1
ITLOW2: PUTBYT 200+":"
MOVEI C,"G" ;FOR END ; MUMBLE
MOVE B,SETSTR
JRST ITLET1
;MACRO MAKERS
MACLET: GETFS(B)
HRRZ D,B
SETZM (D)
ADD D,[XWD 441100,1]
PUSHJ P,PUTINL
JRST PUTRET
SMACNM: GETFS (B)
HRRZ D,B ;HOLD POINTER
SETZM (D) ;CLEAR POINTER TO NEXT
ADD D,[XWD 441100,1];MAKE BYTE POINTER
JUMPE T,PUTRET ;NULL TEXT IF ZERO
MOVEI TT,"+"
SKIPG T
MOVEI TT,"-"
PUSHJ P,DODIV2
JRST PUTRET
MACNUM: GETFS (B)
HRRZ D,B ;HOLD POINTER
SETZM (D) ;CLEAR POINTER TO NEXT
SETZM 1(D) ;CLEAR DATA
ADD D,[XWD 441100,1];MAKE BYTE POINTE
PUSHJ P,DODIV ;PUT IN THE TEXT
PUTRET: MOVEI TT,":"+200;PUT IN THE END
PUTINL: TLNE D,770000 ;END OF WORD?
JRST DODV1 ;NO
GETFS (E) ;YES, GET MORE FREE STORAGE
SETZM (E) ;CLEAR POINTER TO NEXT
SETZM 1(E) ;CLEAR DATA
HRRM E,-1(D) ;POINT TO THIS ONE
HRR D,E
DODV1: IDPB TT,D ;DEPOSIT CHR
POPJ P,
DODIV: SKIPL T
JRST DODIV1
MOVEI TT,"-"
DODIV2: PUSHJ P,PUTINL
MOVM T,T
DODIV1: IDIVI T,=10
SOJG A,DODIV3 ;GO AT LEAST UNTIL WIDTH COUNT RUNS OUT
JUMPE T,DODIV4
DODIV3: HRLM TT,(P)
PUSHJ P,DODIV1
HLRZ TT,(P)
DODIV4: ADDI TT,60
JRST PUTINL
MACCLR: SKIPN T,MDPNT
POPJ P,
MOVSI TT,MACTMP
MCCRL1: ANDCAM TT,(T) ;CLEAR TMP BIT
HRRZ T,(T)
JUMPN T,MCCRL1 ;LOOP THRU ALL
POPJ P,
;READ/WRITE MACRO FILES
WMACRS: SETOM DX1
CAIA
WMACRO: SETZM DX1 ;FLAG NO SELECT
SKIPE VARPNT
JRST WMAC2
SKIPN MDPNT
JRST [ OUTSTR[ASCIZ/NO MACROES.
/]
POPJ P,]
WMAC2: MOVEM P,PERRSAV
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/MACRO /]
MOVSI T,EXTMCR
PUSHJ P,SETNAM ;SET WIRE LIST FILENAME
POPJ P, ;LET HIM OUT
ENTPPN
INIT DAT,10
'DSK '
XWD IOHD,0
JRST [ OUTSTR[ASCIZ/CAN'T GET DISK!
/]
POPJ P,]
MOVEI T,IOBUF
EXCH T,.JBFF
OUTBUF DAT,2
MOVEM T,.JBFF
PUSHJ P,EXIST ;DOES IT EXIST?
POPJ P, ;DOESN'T WANT TO OVERWRITE IT
OUTSTR[ASCIZ/WRITING /]
MOVEI A,FILNAM
JSR FPRINT
ENTER DAT,FILNAM
JRST [ RELEASE DAT,
OUTSTR[ASCIZ/, ENTER FAILED.
/]
POPJ P,]
OUTSTR[ASCIZ/
/]
SKIPN A,VARPNT
JRST WMAC14
TLNN M,DSKACT!MACACT
SKIPN DX1
CAIA
OUTSTR[ASCIZ/VARIABLES:
/]
PUSHJ P,WRTZERO
WMAC4: SKIPN DX1
JRST WMAC4A
TLNE M,DSKACT!MACACT
JRST WMAC4B
HRRZ T,1(A)
PUSHJ P,OUTTXT
WMAC4B: PUSHJ P,YORN
JRST WMAC3 ;SKIP THE REST OF THE VARIABLES ON ALT
JRST WMAC6 ;SKIP THIS ONE ON NO
WMAC4A: HRRZ TT,1(A)
PUSHJ P,WSTR ;WRITE VARIABLES
HLRZ TT,1(A)
JUMPE TT,WMAC5
HLRZ B,(TT)
HRLZ TTT,(TT)
HLR TTT,(B)
TLO TTT,400000
PUSHJ P,WORDOUT
MOVE TT,B
PUSHJ P,WSTR
WMAC13: HLRZ TT,(A)
PUSHJ P,WSTR
WMAC6: HRRZ A,(A)
JUMPN A,WMAC4
WMAC3: PUSHJ P,WRTZERO
WMAC14: SKIPN A,MDPNT
JRST WMAC8
TLNN M,DSKACT!MACACT
SKIPN DX1
CAIA
OUTSTR[ASCIZ/MACROES:
/]
WMAC1: SKIPN DX1
JRST WMAC1A
TLNE M,DSKACT!MACACT
JRST WMAC1B
HRRZ T,1(A)
PUSHJ P,OUTTXT
WMAC1B: PUSHJ P,YORN
JRST WMAC8 ;END ON ALT
JRST WMAC1C ;SKIP ON NO
WMAC1A: HRRZ TT,1(A)
PUSHJ P,WSTR
HLRZ TT,1(A)
PUSHJ P,WSTR ;WORKS FOR 9 BIT TEXT IF NO <META><NULL>'S
WMAC1C: HRRZ A,(A)
JUMPN A,WMAC1
WMAC8: PUSHJ P,WRTZERO
RELEASE DAT,
POPJ P,
WMAC5: HLRZ B,(A)
HLLZ TTT,(B)
SKIPE TTT
MOVEI TTT,1 ;MULTI-STRING VARIABLE
PUSHJ P,WORDOUT
JUMPE TTT,WMAC13
WMAC7: MOVE TT,B
PUSHJ P,WSTR
HLRZ B,(B)
JUMPN B,WMAC7
JRST WMAC6 ;NOTE: NULL STRING WRITTEN AS LAST OF MULTI-STRING VAR
MACOUT: SKIPN A,MDPNT
JRST WRTZERO ;NONE, MARK END
MACOU1: HLRZ TT,(A)
TRNN TT,MSAVE ;SHALL WE SAVE IT?
JRST MACOU3
HRRZ TT,1(A)
PUSHJ P,WSTR ;WRITE MACRO NAME
HLRZ TT,1(A)
PUSHJ P,WSTR ;NOW BODY
MACOU3: HRRZ A,(A)
JUMPN A,MACOU1
PUSHJ P,WRTZERO ;FINISH OFF
POPJ P,
IMACRO: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/MACRO /]
MOVSI T,EXTMCR
PUSHJ P,SETNAM
POPJ P, ;LET HIM OUT
INIT DAT,10
'DSK '
IOHD
JRST [ OUTSTR[ASCIZ/CAN'T GET DISK!
/]
POPJ P,]
OUTSTR[ASCIZ/READING /]
MOVEI A,FILNAM
JSR FPRINT
DEC,< MOVE T,FILPPN >
LOOKUP DAT,FILNAM
JRST LOOKRR
DEC,< JSR DAT,LOOKCK >
OUTSTR[ASCIZ/
/]
MOVEI T,IOBUF
EXCH T,.JBFF
INBUF DAT,2
MOVEM T,.JBFF
PUSHJ P,RSTRZ
CAIA
JRST IMAC2 ;NO VARIABLES
IMAC8: PUSHJ P,RSTRZ ;READ VARIABLE NAME
JRST IMAC1
MOVE D,T
PUSHJ P,OUTTXT ;PRINT ALL VARIABLES
OUTSTR[ASCIZ/
/]
PUSHJ P,VARFND
JRST IMAC6 ;DOESN'T EXIST YET
HLRZ C,1(E)
JUMPE C,IMAC4
HLRZ B,(C)
PUSHJ P,PUTFS
FSTRET (C)
HRRZS 1(E)
IMAC4: HLRZ B,(E)
IMAC5: HLRZ D,(B)
PUSHJ P,PUTFS
SKIPE B,D
JRST IMAC5
IMAC3: PUSHJ P,WORDIN
TLZE TTT,400000
JRST IMAC9
SKIPA C,TTT
IMAC7: MOVE E,T
PUSHJ P,RSTRZ
JRST [ GETFS(T) ;MARK END OF MULTI STRING VAR
SETZM (T) ;WITH NULL STRING
SETZM 1(T)
HRLM T,(E)
JRST IMAC8]
HRLM T,(E)
JUMPN C,IMAC7 ;MULTI-STRING?
JRST IMAC8 ;NO
IMAC6: GETFS (E) ;MAKE NEW VARIABLE
MOVE B,VARPNT
HRRZM B,(E)
HRRZM D,1(E)
MOVEM E,VARPNT
JRST IMAC3
IMAC9: MOVE C,TTT
PUSHJ P,RSTR
GETFS (D)
HRLM D,1(E)
HRLZM T,(D)
HRLM C,(T)
HLRM C,(D)
PUSHJ P,RSTR
HRLM T,(E)
TRNN C,400000
JRST IMAC12
MOVE T,1(T) ;ALPHABETIC VARIABLE
ROT T,7
MOVEM T,1(D)
JRST IMAC8
IMAC12: ADD T,[POINT 7,1]
SETZB A,B
IMAC10: PUSHJ P,GETTT ;CONVERT VALUE TO BINARY
JRST IMAC11
CAIN C,"-"
SOJA A,IMAC10
IMULI B,=10
ADDI B,-"0"(C)
JRST IMAC10
IMAC11: SKIPE A
MOVN B,B
MOVEM B,1(D)
JRST IMAC8
IMAC1: PUSHJ P,RSTRZ
JRST IMAC0
IMAC2: SETZ C, ;CLEAR FLAGS WORD
PUSHJ P,MACINX
IMAC0: RELEASE DAT,
POPJ P,
MACIN: PUSHJ P,RSTRZ
POPJ P,
MACINX: MOVE D,T
PUSHJ P,RSTR ;WORKS FOR 9 BIT IF NO <META><NULL>'S IN MACRO
MOVE A,T
PUSHJ P,ITMAKE ;MAKE THIS ONE
IORM C,(E) ;OR IN BITS
JRST MACIN
;HERE TO DEFINE A NEW (OR REDEFINE AN OLD) VARIABLE
VARDEF: TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /VARIABLE DEFINITION?/]
PUSHJ P,VARNM ;BUILD LIST STRUCTURE FOR NAME
CAIN C,":" ;NAME ENDED WITH ":"?
JRST VARDE4 ;YES
CAIE C,"=" ;NAME ENDED WITH "="?
CAIN C,"_" ;NAME ENDED WITH "_"?
JRST VARDE4 ;YES
JRST INNERR
VARDE4: PUSH P,C ;SAVE NAME TERMINATING CHR
PUSHJ P,VARFND ;OLD VARIABLE?
JRST VARDE1 ;NO, MAKE A NEW ONE
JRST VARDE2
VARDE1: GETFS (E) ;BUILD VARIABLE LIST STRUCTURE
MOVE B,VARPNT
HRRZM B,(E) ;HOOK INTO LIST OF VAR NAMES
HRRZM D,1(E)
HRRZM E,VARPNT
VARDE2: PUSHJ P,TREAD ;READ DEFINITION
MOVE D,B ;SAVE POINTER TO DEFINITION
HLRZ C,1(E) ;RETURN OLD DEFINITION TO FREE STG
JUMPE C,VARDE5 ;MORE STRUCTURE EXISTS?
HLRZ B,(C)
PUSHJ P,PUTFS
VARDE5: MOVE B,(P) ;GET NAME TERMINATING CHR
CAIE B,"=" ;NUMERIC VARIABLE?
JRST VARDE6 ;NO, GO DEFINE STRING VARIABLE
JUMPN C,VARDE8 ;NEED TO BUILD MORE STRUCTURE?
GETFS (C) ;YES
HRLM C,1(E)
SETZM 1(C)
VARDE8: HRLZM D,(C) ;PLUG IN PTR TO NEW DEFINITION
JRST VARDE7
VARDE6: JUMPE C,VARDE7 ;STRUCTURE TO FLUSH?
SETZM (C)
MOVE B,C
PUSHJ P,PUTFS ;YES, FLUSH IT
VARDE7: HLRZ B,(E) ;RETURN OLD VALUE
JUMPE B,VARD10
VARDE9: HLRZ C,(B)
PUSHJ P,PUTFS
SKIPE B,C ;MULTI-STRING VARIABLE VALUE?
JRST VARDE9 ;YES, MORE TO RETURN
VARD10: HRRZS (E) ;CLEAR PTR TO OLD STRUCTURE
POP P,B ;GET NAME TERMINATING CHR
CAIN B,"=" ;NUMERIC VARIABLE?
JRST VARNX0 ;SET UP INITIAL VALUE
HRLM D,(E) ;PLUG IN NEW VALUE
HRRZS 1(E) ;CLEAR PTR TO OLD STRUCTURE
CAIE B,":" ;MULTI-STRING DEFINITION?
POPJ P,
VARDE0: TLNN M,DSKACT!MACACT
OUTCHR [":"] ;PROMPT FOR NEXT LINE
PUSHJ P,TREAD ;GET NEXT STRING
HRLM B,(D) ;SAVE PTR TO STRING
MOVE D,B ;DO NEXT STRING
SKIPE 1(B)
JRST VARDE0
POPJ P,
VARFND: MOVEI E,VARPNT ;SEARCH VARIABLE LIST FOR A NAME
VARFN1: HRRZ E,(E) ;GET PTR TO NEXT VARIABLE
JUMPE E,CPOPJ ;AT END OF LIST?
HRRZ A,1(E) ;NO, COMPARE NAMES
MOVE B,D
PUSHJ P,TXTMAT
JRST VARFN1 ;NOT FOUND, DO NEXT VARIABLE
MOVE B,D ;BINGO!
AOS (P) ;SKIP RETURN
JRST PUTFS ;RETURN NAME TO FREE STG
VARNUM: SETZB TTT,G ;READ ONE NUMBER FROM VARIABLE DEF
VARNU4: PUSHJ P,VARCHR ;GET NEXT CHR
JRST VARNU3 ;AT END
CAIL T,"0" ;NUMERIC?
CAILE T,"9"
JRST VARNU2 ;NO
IMULI TTT,=10 ;COMPILE VALUE
ADDI TTT,-"0"(T)
AOS G ;COUNT CHARACTERS
AOJA D,VARNU4 ;STEP TO NEXT INPUT CHR
VARNU2: CAIN T,"-" ;MINUS?
TROE G,200000 ;YES, 2 MINUSES?
JRST VARNU3 ;NOT MINUS OR 2 MINUSES, QUIT
AOJA D,VARNU4
VARNU3: TRNE G,200000 ;MINUS TYPED?
MOVNS TTT ;YES, SO NEGATE VALUE
POPJ P,
VARCHR: PUSHJ P,VARBYT ;GET PTR TO CHR
POPJ P, ;OFF THE END
LDB T,TT ;GET CHR
JUMPE T,CPOPJ ;AT END
CAIL T,"a" ;LOWER CASE?
CAILE T,"z"
JRST CPOPJ1 ;NO, DONE
SUBI T,40 ;CONVERT TO UPPER CASE
JRST CPOPJ1
VARBYT: MOVE T,C ;GET TEXT PTR
MOVE TT,D ;GET CHR COUNT
VARBY1: CAILE TT,4 ;CHR IN THE CURRENT WORD?
JRST [SUBI TT,5 ;NO, REDUCE COUNT
HRRZ T,(T) ;GET NEXT PTR
JUMPN T,VARBY1 ;AT END?
POPJ P,] ;YES, RETURN
MOVE TT,VARBY2(TT) ;GET BYTE PTR
JRST CPOPJ1
VARBY2: POINT 7,1(T),6 ;TABLE OF BYTE PTRS FOR GETTING CHR
POINT 7,1(T),13
POINT 7,1(T),20
POINT 7,1(T),27
POINT 7,1(T),34
VARNM: GETFS (B) ;READ ONE VARIABLE NAME
PUSH P,B ;SAVE PTR TO START OF STRUCTURE
SETZM (B)
SETZM 1(B)
HRLI B,020700 ;MAKE A BYTE PTR
VARNM2: PUSHJ P,GETLIN ;GET ONE CHR
CAIL C,"a" ;LOWER CASE?
CAILE C,"z"
JRST VARNM1 ;NO
SUBI C,40 ;CONVERT TO UPPER CASE
VARNM3: TLNE B,760000 ;PUT CHR INTO NAME. AT END OF WORD?
JRST VARNM4 ;NO
GETFS (D) ;GET NEW WORD
SETZM (D)
SETZM 1(D)
HRRZM D,-1(B) ;ADD TO END OF STRUCTURE
HRR B,D ;MAKE NEW BYTE PTR
VARNM4: IDPB C,B
JRST VARNM2
VARNM1: CAIL C,"A" ;ALPHABETIC?
CAILE C,"Z"
CAIN C,"." ;PERIOD?
JRST VARNM3 ;YES, VALID SYMBOL CONSTITUENT
CAIL C,"0" ;NUMERIC?
CAILE C,"9"
CAIN C,"%" ;PERCENT?
JRST VARNM3 ;YES, VALID
CAIN C,"$" ;DOLLAR SIGN?
JRST VARNM3 ;YES, VALID
POP P,D ;NO, END OF SYMBOL. GET PTR TO BEGINING
POPJ P,
;HERE TO TYPE THE VALUES OF ALL VARIABLES
VARTYP: TVOFF
MOVEI A,VARPNT ;POINT TO VARIABLE NAME LIST
VARTY1: OUTSTR [ASCIZ /
/]
HRRZ A,(A) ;GET NEXT VARIABLE
JUMPE A,[ TVON ;DONE?
POPJ P,]
HRRZ T,1(A) ;PTR TO NAME
PUSHJ P,OUTTXT
HLRZ T,(A) ;MULTI-STRING VARIABLE?
HLLZ T,(T)
HRRI T,":"
TLZE T,-1
JRST VARTY2 ;YES, FLAG WITH ":"
HLRZ T,1(A) ;STRING VARIABLE?
SKIPN T
TROA T,"_" ;YES, FLAG WITH "_"
MOVEI T,"="
VARTY2: OUTCHR T
HLRZ T,(A) ;PTR TO EXPANSION
PUSHJ P,OUTTXT
JRST VARTY1 ;DO NEXT ONE
;HERE TO INCREMENT A VARIABLE
VARNXT: TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /VARIABLE NAME?/]
PUSHJ P,VARNM ;GET VARIABLE NAME
CAIE C,12 ;ENDED WITH LINE FEED?
JRST INNERR ;NO, ERROR
PUSHJ P,VARFND ;LOOKUP VARIABLE NAME
JRST [VARN99:
TLNN M,MACACT ;NOT FOUND
OUTSTR [ASCIZ /NO SUCH NAME!/]
MOVE B,D ;RETURN NAME TO FREE STG
JRST PUTFS]
VARNX0: HLRZ B,1(E) ;GET PTRS TO VARIOUS PIECES OF STRUCTURE
JUMPE B,VARN40 ;INCREMENTING A STRING VARIABLE?
HLRZ C,(B) ;PTR TO TEXT
HRRZ D,(B) ;CHR NUMBER
PUSHJ P,VARNUM ;NO, GET A NUMBER
TRNN G,177777 ;ANY DIGITS SEEN?
JRST VARNX3 ;NO
PUSHJ P,VARN31 ;CHECK FORMAT
JRST VARILL ;NO, FORMAT ERROR
VARNX5: MOVEM TTT,1(B) ;SAVE VALUE
VARNX7: HRRM D,(B) ;SAVE CHR COUNT
HRLM G,(C) ;SAVE DIGIT COUNT
VARNX8: SKIPL (C) ;ALPHABETIC VARIABLE?
JRST VARN16 ;NO, PUT OUT A NUMBER
HRRZ D,1(B)
HLRZ B,(E) ;GET PTR TO OLD VALUE EXPANSION
PUSHJ P,PUTFS ;RETURN TO FREE STG
GETFS (T) ;MAKE NEW EXPANSION
SETZM (T)
HRLM T,(E)
ROT D,-7
HLLZM D,1(T)
POPJ P,
VARN16: MOVE T,1(B) ;GET THE NUMBER
HLRZ G,(C) ;GET DIGIT COUNT
TRZ G,600000 ;CLR FLAG BITS
GETFS (TTT) ;BUILD NEW EXPANSION
PUSH P,TTT ;SAVE PTR TO BEGINNING
SETZM (TTT)
SETZM 1(TTT)
HRLI TTT,020700 ;MAKE BYTE PTR
PUSHJ P,VARN17 ;DO THE DECIMAL PRINT
HLRZ B,(E) ;RETURN OLD EXPANSION TO FREE STG
PUSHJ P,PUTFS
POP P,T ;PLUG IN NEW EXPANSION
HRLM T,(E)
POPJ P,
VARNX1: JUMPE D,VARILL ;EMPTY DEFINITION?
MOVEI G,1 ;NO USE DEFAULT INCREMENT OF 1
VARNX9: MOVE T,1(B) ;GET VALUE
SKIPGE (C) ;ALPHABETIC?
JUMPN G,VARN15 ;YES, NON-ZERO INCREMENT?
ADD T,G ;NO, ADD INCREMENT TO VALUE
JRST VARN12
VARN15: HRLOI TTT,377777 ;MAKE SUPER-BIG UPPER LIMIT
JUMPG G,VARN14 ;INCREMENT POS?
MOVNS TTT ;NO, MAKE UPPER LIMIT NEGATIVE
JRST VARN14 ;GO TO GIOQ SKIPPER
VARN17: JUMPGE T,VARN19 ;NEGATIVE?
MOVNS T ;YES, SO MAKE POSITIVE
SETZM G ;NO FIXED NUMBER OF DIGITS
MOVEI TT,"-" ;OUTPUT A MINUS SIGN
IDPB TT,TTT
VARN19: IDIVI T,=10 ;RECURSIVE DECIMAL PRINT
HRLM TT,(P)
SOSG G ;DONT ZERO SUPPRESS UNTIL COUNT RUNS OUT
SKIPE T ;ALL DIGITS DONE?
PUSHJ P,VARN19 ;NO
HLRZ TT,(P)
ADDI TT,"0" ;CONVERT DIGIT TO ASCII
VARN20: TLNE TTT,760000 ;WORD FULL?
JRST VARN18 ;NO
GETFS (D) ;YES, GET ANOTHER WORD
HRRZM D,-1(TTT)
SETZM 1(D)
SETZM (D)
HRR TTT,D ;MAKE NEW BYTE PTR
VARN18: IDPB TT,TTT ;SAVE DIGIT
POPJ P,
VARNX3: TRNE G,200000 ;MINUS TYPED?
JRST VARILL ;YES, ERROR BECAUSE NO DIGITS TYPED
JUMPE T,VARNX1 ;AT END OF DEFINITION?
CAIN T,"(" ;INCREMENT COMING?
AOJA D,VARNX2 ;YES, GO GET IT
CAIL T,"A" ;ALPHABETIC VARIABLE?
CAILE T,"Z"
JRST [VARILL:OUTSTR [ASCIZ /ILLEGAL VARIABLE DEFINITION!/]
POPJ P,]
MOVEM T,1(B) ;SAVE VALUE
PUSHJ P,VARN30 ;GET NEXT CHR AND CHECK FORMAT
JRST VARILL ;NO, FORMAT ERROR!
VARNX6: MOVEI G,400000 ;FLAG ALPHABETIC VARIABLE
JRST VARNX7
VARNX2: PUSHJ P,VARNUM ;GET INCREMENT
CAIE T,")" ;MUST END WITH ")"
JRST VARILL
PUSH P,TTT ;SAVE VALUE
AOS D ;STEP TO NEXT CHR
PUSHJ P,VARNUM ;GET UPPER LIMIT
POP P,TT ;GET INCREMENT
TRNN G,177777 ;ANY DIGITS TYPED?
JRST VARN10 ;NO
PUSHJ P,VARN31 ;CHECK FORMAT
JRST VARILL ;NO, FORMAT ERROR
VARN11: JUMPE TT,VARILL ;0 INCREMENT WONT GO ANYWHERE
SKIPGE (C) ;ALPHABETIC?
JRST VARILL ;YES, SO NUMERIC UPPER LIMIT ILLEGAL
MOVE T,1(B) ;GET VALUE
JUMPL TT,[CAMG T,TTT ;ARGS IN RIGHT ORDER FOR NEG INCREMENT?
JRST VARILL ;NO
ADD T,TT ;ADD INCREMENT TO VALUE
CAMG T,TTT ;GONE PAST UPPER LIMIT?
MOVE T,TTT ;YES, USE UPPER LIMIT ITSELF
JRST VARN12];NO
CAML T,TTT ;ARGS IN RIGHT ORDER FOR POS INCREMENT?
JRST VARILL ;NO
ADD T,TT ;ADD INCREMENT TO VALUE
CAML T,TTT ;GONE PAST UPPER LIMIT?
MOVE T,TTT ;YES, USE UPPER LIMIT AS VALUE
VARN12: MOVEM T,1(B) ;SAVE INCREMENTED VALUE
CAMN T,TTT ;AT UPPER LIMIT?
HRRM D,(B) ;YES, UPDATE CHR COUNT
JRST VARNX8 ;EXPAND THE RESULT
VARN10: TRNE G,200000 ;MINUS TYPED?
JRST VARILL ;YES, ILLEGAL ALPHABETIC!
MOVE G,TT ;SAVE INCREMENT
JUMPE T,VARNX9 ;AT END OF DEFINITION?
CAIL T,"A" ;ALPHABETIC UPPER LIMIT?
CAILE T,"Z"
JRST VARILL ;NO
MOVE TTT,T ;SAVE UPPER LIMIT
JUMPE G,VARILL ;INCREMENT 0?
PUSHJ P,VARN30 ;GET NEXT CHR AND CHECK FORMAT
JRST VARILL ;NO, FORMAT ERROR
VARN13: SKIPL (C) ;ALPHABETIC VALUE?
JRST VARILL ;NO, ALPHABETIC UPPER LIMIT ILLEGAL
MOVE T,1(B) ;GET VALUE
VARN14: JUMPL G,[CAMG T,TTT ;ARGS IN RIGHT ORDER FOR NEG INCREMENT?
JRST VARILL ;NO
ADD G,T ;ADD INCREMENT TO VALUE
CAILE T,"Q" ;WENT PAST Q?
CAILE G,"Q"
CAIA ;NO
SOS G ;YES, IT SHOULD BE SKIPPED
CAILE T,"O" ;WENT PAST O?
CAILE G,"O"
CAIA ;NO
SOS G ;YES, IT SHOULD BE SKIPPED
CAILE T,"I" ;WENT PAST I?
CAILE G,"I"
CAIA ;NO
SOS G ;YES, IT SHOULD BE SKIPPED
CAILE T,"G" ;WENT PAST G?
CAILE G,"G"
SKIPA T,G ;NO
SOS T,G ;YES, IT SHOULD BE SKIPPED
CAMG G,TTT ;WENT PAST UPPER LIMIT?
MOVE T,TTT ;YES, USE UPPER LIMIT AS VALUE
JRST VARN12];NO
CAML T,TTT ;ARGS IN RIGHT ORDER FOR POS INCREMENT?
JRST VARILL ;NO
ADD G,T ;ADD VALUE TO INCREMENT
CAIGE T,"G" ;WENT PAST G?
CAIGE G,"G"
CAIA ;NO
AOS G ;YES, IT SHOULD BE SKIPPED
CAIGE T,"I" ;WENT PAST I?
CAIGE G,"I"
CAIA ;NO
AOS G ;YES, IT SHOULD BE SKIPPED
CAIGE T,"O" ;WENT PAST O?
CAIGE G,"O"
CAIA ;NO
AOS G ;YES, IT SHOULD BE SKIPPED
CAIGE T,"Q" ;WENT PAST Q?
CAIGE G,"Q"
SKIPA T,G ;NO
AOS T,G ;YES, IT SHOULD BE SKIPPED
CAML G,TTT ;WENT PAST UPPER LIMIT?
MOVE T,TTT ;YES, USE UPPER LIMIT AS VALUE
JRST VARN12 ;NO
VARN30: AOS D ;STEP TO NEXT CHR
PUSHJ P,VARCHR ;GET IT
VARN31: JUMPE T,CPOPJ1 ;END OF DEFINITION IS LEGAL
CAIN T,"," ;COMMA IS VALID
AOJA D,CPOPJ1 ;MOVE PAST COMMA
CAIE T,"(" ;NEW INCREMENT ALSO LEGAL
POPJ P, ;OTHERS ARE ILLEGAL
JRST CPOPJ1
VARN40: HLRZ C,(E) ;PTR TO STRING
HLRZ D,(C) ;MULTI-STRING VARIABLE
JUMPN D,VARN44 ;NON 0 = MULTISTRING, 0=START AT 1ST CHR
VARN41: PUSHJ P,VARCHR ;SEARCH FOR FIRST NUMBER
JRST [TLNN M,MACACT
OUTSTR [ASCIZ /NO NUMBER TO INCREMENT!/]
POPJ P,]
CAIL T,"0"
CAILE T,"9"
AOJA D,VARN41
MOVE G,D ;SAVE POSITION OF 1ST DIGIT
VARN42: PUSHJ P,VARCHR ;SEARCH FOR END OF NUMBER
JRST .+3 ;END OF DEFINITION
CAIL T,"0"
CAILE T,"9"
SOSA D ;STEP BACK TO LAST DIGIT
AOJA D,VARN42
VARN43: PUSHJ P,VARBYT ;GET BYTE PTR TO CHR
NODEC,< HALT .+1 > ;CANT HAPPEN
DEC,< PUSHJ P,TODDT >
LDB TTT,TT ;GET DIGIT
AOS TTT
CAIN TTT,"9"+1 ;DIGIT OVERFLOW?
MOVEI TTT,"0" ;YES
DPB TTT,TT ;SAVE INCREMENTED DIGIT
CAIE TTT,"0" ;NEED TO PROPAGATE A CARRY?
POPJ P, ;NO
CAMLE D,G ;YES, OVERFLOWING FIELD?
SOJA D,VARN43 ;NO, INCREMENT NEXT DIGIT
OUTSTR [ASCIZ /NUMERIC FIELD OVERFLOW!/]
POPJ P,
VARN44: HRLM D,(E) ;NEXT STRING BECOMES CURRENT VALUE
SKIPN 1(D) ;IS THIS END OF MULTI STRING VAR?
SETOM ENDMUL ;YES, FLAG IT
MOVE B,C ;RETURN OLD STRING
JRST PUTFS
Reference in New Issue View Git Blame Copy Permalink