Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50347/exampl.mac
There is 1 other file named exampl.mac in the archive. Click here to see a list.
;SECTION 1
SEARCH C,TULIP ;ACCESS TULIP AND C DEFINITIONS
TULIP1: MOVE P,[IOWD 40,PDL] ;SET UP PUSHDOWN LIST
START ;CALL UUO TO INITIALIZE TULIP
;SECTION 2
DATE T1, ;GET THE DATE IN FUNNY FORMAT
IDIVI T1,^D31 ;T2_DAY-1
ADDI T2,1 ;FIXT2 SO IT'S NOW 1-31
WDEC T2 ;AND PRINT IT
WCHI "." ;SEPARATE EUPOPEAN STYLE
IDIVI T1,^D12 ;T1_YEARS-64, T2_MONTH-1
WNAME MONTAB(T2) ;PRINT THIS MONTH
WCHI "." ;SEPARATE THIS
ADDI T1,^D64 ;MAKE THIS THE CURRENT YEAR
WDEC T1 ;BOY, THIS IS STILL RATHER TEDIOUS...
W2CHI CRLF ;CRLF IS DEFINED IN TULIP, AND IS JUST THAT
;SECTION 3
DATE T1, ;LET'S DO IT AGAIN, ONLY BETTER!
IDIVI T1,^D<12*31> ;T1_YEAR-64
IDIVI T2,^D< 31> ;T2_MONTH-1, T3_DAY-1
DISIX [[SIXBIT\%.%.%!\]
WDECI 1(T3) ;DAY
WNAME MONTAB(T2);MONTH
WDECI ^D64(T1)];AND YEAR
;SECTION 4
MSTIME T1, ;TOP OFF WITH TIME
IDIVX T1,^D<60*60*1000>;T1_HOURS
IDIVX T2,^D< 60*1000>;T2_MINUTES
IDIVX T3,^D< 1000>;T3_SECONDS, T4_THOUSANTHS
TXO F,LZEFLG ;PRINT TIME WITH LEADING ZEROS
DISIX [[SIXBIT\ %:%:%.%#!\]
WDEC 2,T1 ;HOURS
WDEC 2,T2 ;MINUTES
WDEC 2,T3 ;SECONDS
WDEC 3,T4] ;THOUSANTHS. NOTE THAT THIS NEEDS LEADING ZEROS!
;SECTION 5
MONRT. ;BACK TO MONITOR
EXIT ;IN CASE OF CONTINUE
DEFINE MAKLST (A)<
IRP A<SIXBIT/A/>>
MONTAB: MAKLST <JAN,FEB,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPT,OCT,NOV,DEC>
PDL: BLOCK 40
PRGEND
TITLE TULIP2 - PROGRAM 2 FOR THE TULIP MANUAL
SUBTTL RIC WERME, OCTOBER 1974
SEARCH C,TULIP ;ACCESS TULIP AND C DEFINITIONS
TWOSEG ;GENERATE BOTH SEGMENTS
RELOC 400000 ;STARTING WITH THE HISEG
;SYMBOLS WE NEED:
DTA==0 ;IO CHANNEL FOR DECTAPE
PDLLEN==100 ;LENGTH OF PUSHDOWN LIST
DIRSIZ==200 ;SIZE OF DTA DIRECTORY BLOCK
DIRADR==^D100 ;ADDRESS OF DIRECTORY BLOCK
MAXFIL==^D22 ;MAX # OF FILES THAT WILL FIT ON A TAPE
TAPLEN==^D578 ;# OF BLOCKS ON A DECTAPE
DIRBYT==0 ;RELATIVE ADDR OF DIRECTORY BYTE MAP (5 BIT BYTES)
DIRFIL==^D83 ;RELATIVE ADDR OF FIRST FILENAME
DIREXT==^D105 ;RELATIVE ADDR OF EXTENSION/DATE WORD
DIRLBL==^D127 ;RELATIVE ADDR OF LABEL WORD
ENTRY TULIP2 ;TO LET PEOPLE PLAY WITH THIS
TULIP2: MOVE P,[IOWD PDLLEN,PDL];SET UP PUSHDOWN LIST
START ;CALL UUO TO INITIALIZE TULIP
FSETUP DTAFIH ;SETUP DECTAPE FILE BLOCK
FIGET DTAFIL ;OPEN DECTAPE
USETI DTA,DIRADR ;READY TO READ DIRECTORY
INPUT DTA,[IOWD DIRSIZ,DIRBLK
0] ;AND READ IT. ERROR HANDLING WILL BE IN PROGRAM 3
MOVEI T1,DIRBLK ;PRTDIR WANTS ADDRESS OF DIRECTORY IN T1
PUSHJ P,PRTDIR ;READ, PRINT DIRECTORY
FREL DTAFIL ;RELEASE THE DTA
MONRT. ;AND RETURN TO MONITOR LEVEL
EXIT ;IN CASE OF CONTINUE
;SUBROUTINE TO PRINT A DECTAPE DIRECTORY POINTED AT BY T1 ON
;THE CURRENT OUTPUT CHANNEL. USES T1-T4
PRTDIR: PUSHJ P,SAVE1## ;NEED A PERMANENT AC FOR DIRECTORY ADDR
HRLI T1,-MAXFIL ;MAKE A HANDY AOBJN WORD
MOVE P1,T1 ;AND SAVE IN AN OUT OF THE WAY CORNER
SETZ T2, ;CLEAR FILE COUNTER
FILLOP: SKIPN DIRFIL(T1) ;FREE FILES HAVE A ZERO NAME
MOVEI T2,1(T2) ;WHICH THIS ONE DOES
AOBJN T1,FILLOP ;LOOK AT REST
MOVEM T2,FREFIL ;SAVE FOR LATER USE.
SETZM FILSIZ ;CLEAR OUT COUNT LIST OF FILE SIZES
MOVE T1,[FILSIZ,,FILSIZ+1]
BLT T1,FILSIZ+MAXFIL-1;USING TRIED, TRUE AND SLOW BLT
MOVEI T1,TAPLEN-1 ;# OF BLOCKS TO SCAN (0 ISN'T IN BYTE MAP)
MOVX T2,<POINT 5,DIRBYT(P1)>;POINT TO BEFORE FIRST BYTE IN MAP
SIZLOP: ILDB T3,T2 ;GET OWNER OF THIS BLOCK
AOS FILSIZ(T3) ;COUNT IT (N.B. - FREE BLOCKS ARE IN FILSIZ)
SOJG T1,SIZLOP ;GO FOR NEXT
DISIX [[SIXBIT\D&IRECTORY %#&F&REE: % BLOCKS, % FILES#!\]
PUSHJ P,DATTIM;PRINT DIRECTORY HEADER. FIRST DATE AND TIME
WDEC FILSIZ ;THEN THE FREE BLOCKS
WDEC FREFIL] ;AND THE FREE FILES
SKIPE T1,DIRLBL(P1) ;DOES THIS TAPE HAVE A LABEL?
DISIX [[SIXBIT\T&APE &ID: %#!\]
WNAME T1]
W2CHI CRLF ;SEPARATE HEADER FROM DATA
MOVE T1,FREFIL ;CHECK TO SEE IF ANY REASON TO PRINT
CAIN T1,MAXFIL ; DIRECTORY. SAY EMPTY IF NO FILES WRITTEN
DISIX [CPOPJ##,,[SIXBIT\D&IRECTORY EMPTY#!\]]
MOVEI T4,1 ;MAKE INDEX INTO FILSIZ FOR BLOCKS USED
;NO NEED TO SAVE P1 NOW, USE IT AS AOBJN WORD
DIRLOP: SKIPN DIRFIL(P1) ;DOES THIS FILE EXIST?
JRST DIRAOB ;NO, TRY NEXT
LDB T1,[POINT 12,DIREXT(P1),35];GET LOW 12 BITS OF CREATION DATE
MOVEI T2,1 ;CHECK THE BYTE MAP FOR THE TOP 3 BITS
TDNE T2,DIRBYT(P1)
IORI T1,1B23 ;BRING UPTO 1985
TDNE T2,DIRBYT+MAXFIL(P1)
IORI T1,1B22 ;UPTO 2007
TDNE T2,DIRBYT+<2*MAXFIL>(P1)
IORI T1,1B21 ;UPTO 2051 (FOR THE PDP-10 IN THE SMITHSONIAN)
DISIX [[SIXBIT\%.% % %#!\]
WSIX 6,DIRFIL(P1);FILE
WSIX 3,DIREXT(P1);AND EXTENSION
WDEC 3,FILSIZ(T4);THEN LENGTH
PUSHJ P,DATTHN] ;AND CREATION DATE
DIRAOB: MOVEI T4,1(T4) ;POINT TO NEXT FILE NUMBER
AOBJN P1,DIRLOP ;AND LOOP FOR NEXT FILE
POPJ P, ;OR RETURN WHEN DONE
;SUBROUTINE TO PRINT CURRENT DATE AND TIME AS
; 'ON <DATE> AT <TIME>'
;USES T1-T4
DATTIM: DISIX [CPOPJ##,,[SIXBIT\&ON % AT %!\];PRINT DATE, TIME, THEN RETURN
PUSHJ P,DATPRT ;PRINT CURRENT DATE
PUSHJ P,TIMPRT];PRINT CURRENT TIME
;SUBROUTINE TO PRINT EITHER CURRENT DATE (ENTER AT DATPRT) OR DATE
;PASSED IN T1 (ENTER AT DATTHN). USES T1-T3
DATPRT: DATE T1, ;GET TODAY'S DATE
DATTHN: IDIVI T1,^D<12*31> ;T1_YEAR-64
IDIVI T2,^D< 31> ;T2_MONTH-1, T3_DAY-1
WDECI 2,1(T3) ;DAY
WNAME MONTAB(T2) ;.MONTH.
WDECI ^D64(T1) ;AND YEAR
POPJ P, ;AND RETURN
;SUBROUTINE TO PRINT TODAYS TIME. USES T1-T4, EXITS WITH LZEFLG OFF
TIMPRT: MSTIME T1, ;GET CURRENT TIME
IDIVX T1,^D<60*60*1000>;T1_HOURS
IDIVX T2,^D< 60*1000>;T2_MINUTES
IDIVX T3,^D< 1000>;T3_SECONDS, T4_THOUSANTHS
TXO F,LZEFLG ;PRINT TIME WITH LEADING ZEROS
DISIX [[SIXBIT\%:%:%!\]
WDEC 2,T1 ;HOURS
WDEC 2,T2 ;MINUTES
WDEC 2,T3] ;SECONDS
TXZ F,LZEFLG ;TURN OFF AS PROMISED
POPJ P, ;AND RETURN
DEFINE MAKLST (A)<
IRP A<SIXBIT/.'A'./>>
MONTAB: MAKLST <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
DTAFIH: FILE DTA,I,DTAFIL,<STATUS(IO.NSD!.IODMP),DEV(DTA0)>
RELOC 0 ;POINT TO LOWSEG DATA
DTAFIL: BLOCK FBSIZE ;CORRESPONDING LOSEG BLOCK FOR DTAFIH
DIRBLK: BLOCK DIRSIZ ;WHERE WE READ DIRECTORY
FREFIL: BLOCK 1 ;WHERE WE PUT # OF FREE FILES
FILSIZ: BLOCK 40 ;NEED 40 ENTRIES FOR ANY BYTE SIZE
PDL: BLOCK PDLLEN
PRGEND
SUBTTL RIC WERME, OCTOBER 1974
SEARCH C,TULIP ;ACCESS TULIP AND C DEFINITIONS
TWOSEG ;GENERATE BOTH SEGMENTS
RELOC 400000 ;STARTING WITH THE HISEG
VERSION(3,,2,0) ;VERSION, UPDATE, EDIT, WHO
DEFINE XX(VER,UPD,EDIT,WHO)<
IFIDN <WHO><0>,<
TITLE TULIP3 - VERSION VER'UPD(EDIT) - PROGRAM 3 FOR TULIP MANUAL
VERMSG: SIXBIT \TULIP3 V'VER'UPD(EDIT)#!\
>IFDIF <WHO><0>,<
TITLE TULIP3 - VERSION VER'UPD(EDIT)-WHO - PROGRAM 3 FOR TULIP MANUAL
VERMSG: SIXBIT \TULIP3 V'VER'UPD(EDIT)-WHO#!\
>>
VERSTR
;SYMBOLS WE NEED:
DTA==0 ;IO CHANNEL FOR DECTAPE
TTY==1 ; AND FOR TTY
PDLLEN==100 ;LENGTH OF PUSHDOWN LIST
DIRSIZ==200 ;SIZE OF DTA DIRECTORY BLOCK
DIRADR==^D100 ;ADDRESS OF DIRECTORY BLOCK
MAXFIL==^D22 ;MAX # OF FILES THAT WILL FIT ON A TAPE
TAPLEN==^D578 ;# OF BLOCKS ON A DECTAPE
DIRBYT==0 ;RELATIVE ADDR OF DIRECTORY BYTE MAP (5 BIT BYTES)
DIRFIL==^D83 ;RELATIVE ADDR OF FIRST FILENAME
DIREXT==^D105 ;RELATIVE ADDR OF EXTENSION/DATE WORD
DIRLBL==^D127 ;RELATIVE ADDR OF LABEL WORD
ENTRY TULIP3 ;TO LET PEOPLE PLAY WITH THIS
TULIP3: MOVE P,[IOWD PDLLEN,PDL];SET UP PUSHDOWN LIST
START ;CALL UUO TO INITIALIZE TULIP
FSETUP DTAFIH ;SETUP DECTAPE FILE BLOCK
FSETUP TTYFIH ;SETUP BOTH TTY BLOCKS
FSETUP TTYFOH
FIOPEN TTYFIL ;AND GET TTY FOR COMMAND PROCESSING
FOOPEN TTYFOL ;AND FOR OUTPUT, TOO.
WSIX VERMSG ;PRINT GREETING
TRYAGN: WSIX [SIXBIT\DEC&TAPE NAME: !\]
OUTPUT TTY, ;FORCE OUTPUT TO TTY BEFORE INPUT
MOVEI T1,LEXTAB ;ENTER AT FIRST PRODUCTION IN LEXTAB
PUSHJ P,LEXINT## ;PROCESS DECTAPE NAME
FIGET DTAFIL ;OPEN DECTAPE
USETI DTA,DIRADR ;READY TO READ DIRECTORY
IN DTA,[IOWD DIRSIZ,DIRBLK
0] ;AND READ IT.
SKIPA T1,[DIRBLK] ;NO ERROR. GET DIRECTORY ADDR AND SKIP ERROR REPORTER
DISIX [DTAREL,,[SIXBIT\#!\];THIS IS A GREAT USE FOR DISIX...
ERRIN DTAFIL] ;REPORT INPUT ERROR AND PUNT
MOVEI T1,DIRBLK ;PRTDIR WANTS ADDRESS OF DIRECTORY IN T1
PUSHJ P,PRTDIR ;READ, PRINT DIRECTORY
DTAREL: FREL DTAFIL ;RELEASE THE DTA
DTARE1: FISEL TTYFIL ;POINT BACK TO TTY INPUT
JRST TRYAGN ;GO GET ANOTHER
TTYEOF: FICLOS TTYFIL ;HERE IF USER TYPES ^Z
MONRT. ;CLOSE TTY AND RETURN TO MONITOR LEVEL
EXIT ;IN CASE OF CONTINUE
DTAOPN: ERRIOP DTAFIL ;TELL WHY WE COULDN'T OPEN IT
JRST DTARE1 ;RESELECT THE TTY AND TRY AGAIN
;SUBROUTINE TO PRINT A DECTAPE DIRECTORY POINTED AT BY T1 ON
;THE CURRENT OUTPUT CHANNEL. USES T1-T4
PRTDIR: PUSHJ P,SAVE1## ;NEED A PERMANENT AC FOR DIRECTORY ADDR
HRLI T1,-MAXFIL ;MAKE A HANDY AOBJN WORD
MOVE P1,T1 ;AND SAVE IN AN OUT OF THE WAY CORNER
SETZ T2, ;CLEAR FILE COUNTER
FILLOP: SKIPN DIRFIL(T1) ;FREE FILES HAVE A ZERO NAME
MOVEI T2,1(T2) ;WHICH THIS ONE DOES
AOBJN T1,FILLOP ;LOOK AT REST
MOVEM T2,FREFIL ;SAVE FOR LATER USE.
SETZM FILSIZ ;CLEAR OUT COUNT LIST OF FILE SIZES
MOVE T1,[FILSIZ,,FILSIZ+1]
BLT T1,FILSIZ+MAXFIL-1;USING TRIED, TRUE AND SLOW BLT
MOVEI T1,TAPLEN-1 ;# OF BLOCKS TO SCAN (0 ISN'T IN BYTE MAP)
MOVX T2,<POINT 5,DIRBYT(P1)>;POINT TO BEFORE FIRST BYTE IN MAP
SIZLOP: ILDB T3,T2 ;GET OWNER OF THIS BLOCK
AOS FILSIZ(T3) ;COUNT IT (N.B. - FREE BLOCKS ARE IN FILSIZ)
SOJG T1,SIZLOP ;GO FOR NEXT
DISIX [[SIXBIT\D&IRECTORY %#&F&REE: % BLOCKS, % FILES#!\]
PUSHJ P,DATTIM;PRINT DIRECTORY HEADER. FIRST DATE AND TIME
WDEC FILSIZ ;THEN THE FREE BLOCKS
WDEC FREFIL] ;AND THE FREE FILES
SKIPE T1,DIRLBL(P1) ;DOES THIS TAPE HAVE A LABEL?
DISIX [[SIXBIT\T&APE &ID: %#!\]
WNAME T1]
W2CHI CRLF ;SEPARATE HEADER FROM DATA
MOVE T1,FREFIL ;CHECK TO SEE IF ANY REASON TO PRINT
CAIN T1,MAXFIL ; DIRECTORY. SAY EMPTY IF NO FILES WRITTEN
DISIX [CPOPJ##,,[SIXBIT\D&IRECTORY EMPTY###!\]]
MOVEI T4,1 ;MAKE INDEX INTO FILSIZ FOR BLOCKS USED
;NO NEED TO SAVE P1 NOW, USE IT AS AOBJN WORD
DIRLOP: SKIPN DIRFIL(P1) ;DOES THIS FILE EXIST?
JRST DIRAOB ;NO, TRY NEXT
LDB T1,[POINT 12,DIREXT(P1),35];GET LOW 12 BITS OF CREATION DATE
MOVEI T2,1 ;CHECK THE BYTE MAP FOR THE TOP 3 BITS
TDNE T2,DIRBYT(P1)
IORI T1,1B23 ;BRING UPTO 1985
TDNE T2,DIRBYT+MAXFIL(P1)
IORI T1,1B22 ;UPTO 2007
TDNE T2,DIRBYT+<2*MAXFIL>(P1)
IORI T1,1B21 ;UPTO 2051 (FOR THE PDP-10 IN THE SMITHSONIAN)
DISIX [[SIXBIT\%.% % %#!\]
WSIX 6,DIRFIL(P1);FILE
WSIX 3,DIREXT(P1);AND EXTENSION
WDEC 3,FILSIZ(T4);THEN LENGTH
PUSHJ P,DATTHN] ;AND CREATION DATE
DIRAOB: MOVEI T4,1(T4) ;POINT TO NEXT FILE NUMBER
AOBJN P1,DIRLOP ;AND LOOP FOR NEXT FILE
WSIX [SIXBIT\##!\] ;ADD A LITTLE SPACE
POPJ P, ;OR RETURN WHEN DONE
;SUBROUTINE TO PRINT CURRENT DATE AND TIME AS
; 'ON <DATE> AT <TIME>'
;USES T1-T4
DATTIM: DISIX [CPOPJ##,,[SIXBIT\&ON % AT %!\];PRINT DATE, TIME, THEN RETURN
PUSHJ P,DATPRT ;PRINT CURRENT DATE
PUSHJ P,TIMPRT];PRINT CURRENT TIME
;SUBROUTINE TO PRINT EITHER CURRENT DATE (ENTER AT DATPRT) OR DATE
;PASSED IN T1 (ENTER AT DATTHN). USES T1-T3
DATPRT: DATE T1, ;GET TODAY'S DATE
DATTHN: IDIVI T1,^D<12*31> ;T1_YEAR-64
IDIVI T2,^D< 31> ;T2_MONTH-1, T3_DAY-1
WDECI 2,1(T3) ;DAY
WNAME MONTAB(T2) ;.MONTH.
WDECI ^D64(T1) ;AND YEAR
POPJ P, ;AND RETURN
;SUBROUTINE TO PRINT TODAYS TIME. USES T1-T4, EXITS WITH LZEFLG OFF
TIMPRT: MSTIME T1, ;GET CURRENT TIME
IDIVX T1,^D<60*60*1000>;T1_HOURS
IDIVX T2,^D< 60*1000>;T2_MINUTES
IDIVX T3,^D< 1000>;T3_SECONDS, T4_THOUSANTHS
TXO F,LZEFLG ;PRINT TIME WITH LEADING ZEROS
DISIX [[SIXBIT\%:%:%!\]
WDEC 2,T1 ;HOURS
WDEC 2,T2 ;MINUTES
WDEC 2,T3] ;SECONDS
TXZ F,LZEFLG ;TURN OFF AS PROMISED
POPJ P, ;AND RETURN
SUBTTL LEXICAL ANALYSIS
TBLBEG LEXTAB; PARSER FOR A DEVICE NAME
PROD( NULL , ,*,. ) ;IGNORE ANY NULLS LEFT BEHIND
PROD( <SG> ,SIXI, , ) ;INIT SIXBIT PARSER
PROD( <LETTER!DIGIT> ,SIXS,*,. ) ;SAVE THIS CHARACTER
PROD( <SG> ,STOR, , ) ;STORE DEVICE NAME
PROD( -<BREAK> , ,*,. ) ;THROW AWAY REST OF LINE
PROD( <SG> ,RET , , ) ;RETURN
TBLEND
A.SIXI: MOVE T2,[POINT 6,T1] ;SETUP POINTER TO WHERE WE'LL ACCUMULATE THE NAME
SETZ T1, ;AND CLEAR THAT OF ANY GARBAGE IT MIGHT HAVE
POPJ P, ;BACK TO SCAN FIRST CHARACTER
A.SIXS: TRNE P3,LGLSIX ;THIS IS CUTE. WE MAY HAVE ONE OF 3 TYPES OF CHARS:
;NUM, RANGE 60-71 (SIXBIT 20-31)
;UC, RANGE 101-132 (41-72)
;LC, RANGE 141-172 (41-72)
;SO, IF IT IS LEGAL SIXBIT, WE HAVE TO COMPLEMENT
;BIT 40:
XORI P2,40 ;LIKE THAT, WHILE LEAVING LOWER CASE ALONE
TLNE T2,770000 ;MORE CUTENESS. THIS FIELD IS 0 AFTER T1 IS FILLED
IDPB P2,T2 ;STUFF INTO T1
POPJ P, ;AND BACK FOR MORE
A.STOR: MOVEM T1,DTAFIL+FILDEV;SAVE DEVICE IN DTA FILE BLOCK
POPJ P,
DEFINE MAKLST (A)<
IRP A<SIXBIT/.'A'./>>
MONTAB: MAKLST <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
DTAFIH: FILE DTA,I,DTAFIL,<STATUS(IO.NSD!.IODMP),OPEN(DTAOPN)>
TTYFIH: FILE TTY,I,TTYFIL,<DEV(TTY),OTHER(TTYFOL),EOF(TTYEOF)>
TTYFOH: FILE TTY,O,TTYFOL,<DEV(TTY),OTHER(TTYFIL)>
RELOC 0 ;POINT TO LOWSEG DATA
DTAFIL: BLOCK FBSIZE ;CORRESPONDING LOSEG BLOCK FOR DTAFIH
TTYFIL: BLOCK FBSIZE ; AND FOR THE REST
TTYFOL: BLOCK FBSIZE
DIRBLK: BLOCK DIRSIZ ;WHERE WE READ DIRECTORY
FREFIL: BLOCK 1 ;WHERE WE PUT # OF FREE FILES
FILSIZ: BLOCK 40 ;NEED 40 ENTRIES FOR ANY BYTE SIZE
PDL: BLOCK PDLLEN
RELOC ;BACK TO HISEG FOR LITERAL DATA
PRGEND
SUBTTL RIC WERME, OCTOBER 1974
SEARCH C,TULIP ;ACCESS TULIP AND C DEFINITIONS
TWOSEG ;GENERATE BOTH SEGMENTS
RELOC 400000 ;STARTING WITH THE HISEG
VERSION(4,,3,0) ;VERSION, UPDATE, EDIT, WHO
DEFINE XX(VER,UPD,EDIT,WHO)<
IFIDN <WHO><0>,<
TITLE TULIP4 - VERSION VER'UPD(EDIT) - PROGRAM 4 FOR TULIP MANUAL
VERMSG: SIXBIT \TULIP4 V'VER'UPD(EDIT)#!\
>IFDIF <WHO><0>,<
TITLE TULIP4 - VERSION VER'UPD(EDIT)-WHO - PROGRAM 4 FOR TULIP MANUAL
VERMSG: SIXBIT \TULIP4 V'VER'UPD(EDIT)-WHO#!\
>>
VERSTR
DEFINE GETCHN(CHN)< ;;MACRO TO DEFINE ANY IO CHANNELS WE NEED
CHN==<$CHN==$CHN+1>>
$CHN==-1 ;INIT GETCHN MACRO
;SYMBOLS WE NEED:
FB=11 ;DEFINE OUR OWN AC - HAS ADDR OF FILE BLOCK FOR FILSPC
FLAG (FSTDIR) ;ON MEANS SHORT FORMAT DIRECTORY
FLAG (PRSDFL) ;SET WHEN A FILENAME IS PARSED
FLAG (LSTOPN) ;SET WHENEVER A LIST FILE IS OPENED, TO
; REMIND US TO CLOSE IT
FLAG (UNLOAD) ;SET BY UNLOAD SWITCH, TELLS A.DIRE
; TO REWIND IT WHEN WE'RE DONE
GETCHN (DTA) ;IO CHANNEL FOR DECTAPE
GETCHN (TTY) ; AND FOR TTY
GETCHN (LST) ;THEN THE LST DEVICE
GETCHN (CMD0) ;AND THE FIRST COMMAND FILE
PDLLEN==100 ;LENGTH OF PUSHDOWN LIST
DIRSIZ==200 ;SIZE OF DTA DIRECTORY BLOCK
DIRADR==^D100 ;ADDRESS OF DIRECTORY BLOCK
MAXFIL==^D22 ;MAX # OF FILES THAT WILL FIT ON A TAPE
TAPLEN==^D578 ;# OF BLOCKS ON A DECTAPE
DIRBYT==0 ;RELATIVE ADDR OF DIRECTORY BYTE MAP (5 BIT BYTES)
DIRFIL==^D83 ;RELATIVE ADDR OF FIRST FILENAME
DIREXT==^D105 ;RELATIVE ADDR OF EXTENSION/DATE WORD
DIRLBL==^D127 ;RELATIVE ADDR OF LABEL WORD
ENTRY TULIP4 ;TO LET PEOPLE PLAY WITH THIS
TULIP4: MOVE P,[IOWD PDLLEN,PDL];SET UP PUSHDOWN LIST
START ;CALL UUO TO INITIALIZE TULIP
FSETUP DTAFIH ;SETUP DECTAPE FILE BLOCK
FSETUP TTYFIH ;SETUP BOTH TTY BLOCKS
FSETUP TTYFOH
FIOPEN TTYFIL ;AND GET TTY FOR COMMAND PROCESSING
FOSEL TTYFOL ;DID THE OPEN, NO NEED TO DO IT AGAIN
MOVEI T1,TTYFOL ;SINCE WE NEVER ALLOW OPENS ON TTY (SORT OF),
MOVEM T1,EFILE## ; WE CAN FAIRLY SAFELY PUT ERRORS ON THE TTY BLOCK
INBUF TTY,1 ;SHOULDN'T NEED MORE THAN 1 BUFFER
WSIX VERMSG ;IDENTIFY OURSELVES AND GET SOME OUTPUT BUFFERS
MOVE T1,.JBFF## ;SAVE FIRST FREE LOC AFTER TTY
MOVEM T1,SJBFF ;SO WE CAN REUSE BUFFER SPACE EACH COMMAND
TRYAGN: MOVE T1,SJBFF ;RECLAIM ANY CORE USED BY LAST COMMAND
MOVEM T1,.JBFF## ;OR ACT AS NOP ON FIRST TIME THRU
WCHI "*" ;STANDARD PROMPT
OUTPUT TTY, ;FORCE OUTPUT TO TTY BEFORE INPUT
MOVEI T1,LEXTAB ;ENTER AT FIRST PRODUCTION IN LEXTAB
PUSHJ P,LEXINT## ;PROCESS DECTAPE NAME
EWSIX [SIXBIT\S&YNTAX ERROR.#!\]
TXZE F,LSTOPN ;HAVE WE BEEN USING A LIST FILE?
FOCLOS LSTFOL ;YES, CLOSE IT
FISEL TTYFIL ;POINT BACK TO TTY INPUT
FOSEL TTYFOL ;AND TTY OUTPUT
JRST TRYAGN ;GO GET ANOTHER
TTYEOF: ;HERE ON TTY END OF FILE
TXZE F,LSTOPN ;HAVE WE BEEN USING A LIST FILE?
FOCLOS LSTFOL ;YES, CLOSE IT
FOCLOS TTYFIL ;RELEASE TTY CHANNEL
MONRT. ;AND GO BACK TO THE MONITOR
EXIT ;HMM. THIS GUY WON'T TAKE MONRT. FOR AN ANSWER
;SUBROUTINE TO PRINT A DECTAPE DIRECTORY POINTED AT BY T1 ON
;THE CURRENT OUTPUT CHANNEL. USES T1-T4
;WARNING: ZERDIR AND DIRXIT MAY BE REACHED WITHOUT SAVE1 BEING CALLED!!
PRTDIR: HRLI T1,-MAXFIL ;MAKE AN AOBJN POINTER (MUCH MORE USEFUL)
TXNN F,FSTDIR ;USER WANT A SHORT FORM DIRECTORY?
JRST LNGDIR ;NO, GIVE HIM THE WORKS
SETZ T2, ;USE T2 TO 'COUNT' FILES WE SEE
FSTLOP: SKIPE T3,DIRFIL(T1) ;THIS IS SO EASY MIGHT AS WELL DO IT IN A SEPARATE LOOP
DISIX [[SIXBIT\%.%#!\];CRAM FILE AND EXTENSION
WSIX 6,DIRFIL(T1);ON EACH LINE
WSIX 3,DIREXT(T1)]
IOR T2,T3 ;OR IT IN...NON 0 WILL SAY WE FOUND SOME
AOBJN T1,FSTLOP ;GET ANOTHER
JUMPE T2,ZERDIR ;SAY IF DIRECTORY EMPTY
JRST DIRXIT ;A COUPLE OF CRLFS AND RETURN
;HERE TO PRINT ALL THE USEFUL DIRECTORY INFORMATION FOR THE LONG FORMAT
LNGDIR: PUSHJ P,SAVE1## ;NEED A PERMANENT AC FOR DIRECTORY ADDR
MOVE P1,T1 ;KEEP A COPY OF THE AOBJN WORD FOR LATER USE
;COUNT ALL THE FREE FILES (SHOWN BY A ZERO FILE NAME)
SETZ T2, ;CLEAR FILE COUNTER
FILLOP: SKIPN DIRFIL(T1) ;FREE FILES HAVE A ZERO NAME
MOVEI T2,1(T2) ;WHICH THIS ONE DOES
AOBJN T1,FILLOP ;LOOK AT REST
MOVEM T2,FREFIL ;SAVE FOR LATER USE.
;FIGURE OUT HOW MANY BLOCKS EACH FILE HAS ALLOCATED
SETZM FILSIZ ;CLEAR OUT COUNT LIST OF FILE SIZES
MOVE T1,[FILSIZ,,FILSIZ+1]
BLT T1,FILSIZ+MAXFIL-1;USING TRIED, TRUE AND SLOW BLT
MOVEI T1,TAPLEN-1 ;# OF BLOCKS TO SCAN (0 ISN'T IN BYTE MAP)
MOVX T2,<POINT 5,DIRBYT(P1)>;POINT TO BEFORE FIRST BYTE IN MAP
SIZLOP: ILDB T3,T2 ;GET OWNER OF THIS BLOCK
AOS FILSIZ(T3) ;COUNT IT (N.B. - FREE BLOCKS ARE IN FILSIZ)
SOJG T1,SIZLOP ;GO FOR NEXT
;COLLECTED ALL THE DATA WE NEED, PRINT THE HEADER NOW
DISIX [[SIXBIT\D&IRECTORY %#&F&REE: % BLOCKS, % FILES#!\]
PUSHJ P,DATTIM;PRINT DIRECTORY HEADER. FIRST DATE AND TIME
WDEC FILSIZ ;THEN THE FREE BLOCKS
WDEC FREFIL] ;AND THE FREE FILES
SKIPE T1,DIRLBL(P1) ;DOES THIS TAPE HAVE A LABEL?
DISIX [[SIXBIT\T&APE &ID: %#!\]
WNAME T1]
W2CHI CRLF ;SEPARATE HEADER FROM DATA
MOVE T1,FREFIL ;CHECK TO SEE IF ANY REASON TO PRINT
CAIN T1,MAXFIL ; DIRECTORY. SAY EMPTY IF NO FILES WRITTEN
ZERDIR: DISIX [CPOPJ##,,[SIXBIT\D&IRECTORY EMPTY###!\]]
MOVEI T4,1 ;MAKE INDEX INTO FILSIZ FOR BLOCKS USED
;NO NEED TO SAVE P1 NOW, USE IT AS AOBJN WORD
;NOW PRINT OUT INFO FOR EACH FILE
DIRLOP: SKIPN DIRFIL(P1) ;DOES THIS FILE EXIST?
JRST DIRAOB ;NO, TRY NEXT
LDB T1,[POINT 12,DIREXT(P1),35];GET LOW 12 BITS OF CREATION DATE
MOVEI T2,1 ;CHECK THE BYTE MAP FOR THE TOP 3 BITS
TDNE T2,DIRBYT(P1)
IORI T1,1B23 ;BRING UPTO 1985
TDNE T2,DIRBYT+MAXFIL(P1)
IORI T1,1B22 ;UPTO 2007
TDNE T2,DIRBYT+<2*MAXFIL>(P1)
IORI T1,1B21 ;UPTO 2051 (FOR THE PDP-10 IN THE SMITHSONIAN)
DISIX [[SIXBIT\%.% % %#!\]
WSIX 6,DIRFIL(P1);FILE
WSIX 3,DIREXT(P1);AND EXTENSION
WDEC 3,FILSIZ(T4);THEN LENGTH
PUSHJ P,DATTHN] ;AND CREATION DATE
DIRAOB: MOVEI T4,1(T4) ;POINT TO NEXT FILE NUMBER
AOBJN P1,DIRLOP ;AND LOOP FOR NEXT FILE
DIRXIT: WSIX [SIXBIT\##!\] ;ADD A LITTLE SPACE
POPJ P, ;OR RETURN WHEN DONE
SUBTTL LEXICAL ANALYSIS - PRODUCTION TABLE
TBLBEG LEXTAB
PROD( NULL , ,*,. ) ;IGNORE ANY NULLS LEFT BEHIND
PROD( <BLANK> , ,*,. ) ;SKIP BLANKS
COMCON: PROD( <SG> ,FINI, , ) ;CLEAR LEFTOVER SWITCHES
COMCOC: PROD( <SG> ,CALL, ,SWITCH) ;CHECK FOR LEADING SWITCHES
PROD( <SG> , , ,CMDERR) ;BAD SWITCH, ABORT REST OF CMD
PROD( <SG> ,CCAL, ,FILSPC) ;GET INPUT OR OUTPUT SPEC
PROD( <SG> ,CALL, ,SWITCH) ;AND CHECK TRAILING SWITCHES
PROD( <SG> , , ,CMDERR) ;AGAIN, BAD SWITCH
PROD( "_" ,OUTF,*,COMCOC) ;IF OUTPUT, OPEN IT AND
PROD( "=" ,OUTF,*,COMCOC) ;AND CONTINUE WITHOUT CLEARING FLAGS
PROD( <SG> ,DIRE, , ) ;MUST BE DTA, DIRE IT
PROD( COMMA , ,*,COMCON) ;AND SCAN OVER THE TRAILING COMMA
PROD( SEMI , ,*,COMCON) ;ALSO ALLOW ;
PROD( CR , ,*, ) ;IF NOT COMMA, MUST BE END OF LINE
PROD( "Z"-100 , ,*, ) ;READ NEXT CHAR TO GET EOF (KLUDGE)
PROD( <BREAK> ,SRET, , ) ;SO WE MUST HAVE A BREAK HERE
CMDERR: PROD( -<BREAK> , ,*,. ) ;THROW AWAY REST OF LINE
PROD( "Z"-100 , ,*, ) ;ALSO HAVE TO CHECK FOR ^Z HERE...
CRET: PROD( <SG> ,RET , , ) ;RETURN
;SWITCH PARSERS. ALL SWITCHES CONSIST OF AT LEAST A "/" IMMEDIATELY
;FOLLOWED BY A SIXBIT NAME. CALL HERE VIA 'PROD( <SG>,CALL, , SWITCH)' WHICH
;WILL PARSE ANY SWITCHES AT THIS POINT. ACTION ROUTINE SWIT WILL LOOK UP THE SWITCH
;NAME IN A TABLE AND DISPATCH ACCORDINGLY TO PARSE ANY REMAINING DATA. (E.G.
;/CMD:FOO.BAR). FOR THE SWITCHES WITH NOTHING ELSE AFTER THEM. THEY MAY GO TO
;SHRTSW WHICH DOES NO FURTHER PROCESSING ON THAT SWITCH (E.G. /FAST).
;ALL SWITCH PARSERS MUST EXIT TO SWITMR TO CHECK FOR THE POSSIBLITY OF
;MULTIPLE SWITCHES.
SHRTSW:SWITMR: ;USE LABELS FOR SPECIAL CASES
SWITCH: PROD( -"/" ,SRET, , ) ;IF NO SLASH, CAN'T COMPLAIN
PROD( <SG> , ,*, ) ;SKIP THE SLASH
SWITC1: PROD( <SG> ,CALL, ,SIXSCN) ;GET SWITCH NAME
PROD( <SG> ,SWIT, , ) ;PROCESS SWITCH AND DISPATCH
SWITER==CRET ;FOR TIME BEING, SWITCH ERROR IS EASY
CMDFSW: PROD( ":" , ,*,CMDF1 ) ;BETTER FOLLOW WITH A COLON
PROD( <SG> , , ,SWITER) ;CHECK INTO LATER
CMDF1: PROD( <SG> ,ACAL, ,FILSPC) ;WILL GOTO CALL
PROD( <SG> ,DCMD, ,SWITMR) ;POINT TO COMMAND FILE
PAUSSW: PROD( <SG> ,PAUS, ,SWITMR) ;A SIMPLE SWITCH THAT NEEDS CODE DONE
;STANDARD SUBROUTINES (IT WOULD BE NICE TO MAKE THESE INTO A
;SEPARATE PROGRAM SINCE THEY MANAGE TO POP UP ALL THE TIME.)
;PRODUCTIONS TO PARSE THE CLASSIC FILE SPECIFIER (DEV:FILE.EXT[P,PN]
;IN ITS BIGGEST FORM)
;CALL WITH REGISTER FB POINTING TO THE LOSEG FILE BLOCK TO FILL.
FILSPC: PROD( <SG> ,FILI, , ) ;INIT FILE PARSER FLAGS
NXTATM: PROD( <SG> ,CALL, ,SIXSCN) ;GET A NAME
PROD( ":" ,DEV ,*,NXTATM) ;COLON MEANS A DEVICE
PROD( "." ,NAME,*,NXTATM) ;AND PERIOD MEANS NAME
PROD( "[" ,NAMX,*,PPNSCN) ;THEN BRACKET MEANS NAME OR EXT
PROD( <SG> ,NAMX, , ) ;ANYTHING ELSE IS SAME
PPNDON: PROD( <SG> ,RET , , ) ;QUIT WHILE AHEAD
PPNSCN: PROD( <SG> ,CALL, ,OCTSCN) ;GET PROJECT NUMBER
PROD( <SG> ,PROJ,*,OCTSCN) ;SAVE PROJECT. PROJ WILL FAKE CALL
PROD( "]" , ,*, ) ;OPTIONAL CLOSE BRACKET
PROD( <SG> ,PROG, ,PPNDON) ;MERGE WITH PROJECT
OCTSCN: PROD( <BLANK> , ,*,. ) ;SKIP BLANKS
PROD( <SG> ,OCTI, , ) ;INIT OCTAL PACKER
PROD( <DIGIT> ,OCTS,*,. ) ;HMM. MAYBE WE SHOULD DEFINE OCTIT?
PROD( <SG> , , ,SKPBLA) ;SKIP BLANKS AND RETURN
SIXSCN: PROD( <BLANK> , ,*,. ) ;SKIP BLANKS
PROD( <SG> ,SIXI, , ) ;SETUP SIXBIT PACKER
PROD( <LETTER!DIGIT> ,SIXS,*,. ) ;SAVE ANY ALPHANUMERICS
SKPBLA: PROD( <BLANK> , ,*,. ) ;IGNORE BLANKS
PROD( <SG> ,RET , , ) ;AND RETURN
TBLEND
SUBTTL LEXICAL ANALYSIS - ACTION ROUTINES
A.OUTF: TXOE F,LSTOPN ;IS THIS A NEW LIST FILE?
FOCLOS LSTFOL ;YES, CLOSE THIS ONE SO WE CAN OPEN ANOTHER
FSETUP LSTFOH ;INIT FILE BLOCK AND SETUP DEFAULTS
SKIPE T1,DTAFIL+FILDEV;SAVE OUTPUT SPEC WHERE IT BELONGS
MOVEM T1,LSTFOL+FILDEV; DEVICE
CAMN T1,[SIXBIT/TTY/];IF POINTING BACK TO TTY,
JRST [TXZ F,LSTOPN;JUST USE THE NORMAL TTY BLOCK
FOSEL TTYFOL ;CAUSE OTHERWISE WE WILL REDIRECT OUTPUT
POPJ P,] ;AND THEN DO A CLOSE ON IT. NOT GOOD.
SKIPE T1,DTAFIL+FILNAM
MOVEM T1,LSTFOL+FILNAM; NAME
SKIPE T1,DTAFIL+FILEXT
MOVEM T1,LSTFOL+FILEXT; EXTENSION
SKIPE T1,DTAFIL+FILPPN
MOVEM T1,LSTFOL+FILPPN; PPN
FOOPEN LSTFOL ;AND GET THE FILE
POPJ P, ;NOW OUTPUT WILL GO THERE
A.CCAL: FSETUP DTAFIH ;GIVE US A CLEAN SLATE
MOVEI FB,DTAFIL ;POINT TO FILE BLOCK TO FILL
PJRST A.CALL## ;AND GO OFF TO FILSPC
A.DIRE: SKIPE T1,DTAFIL+FILNAM;KLUDGE TO LET PEOPLE TYPE DECTAPE NAMES
MOVEM T1,DTAFIL+FILDEV; WITHOUT USING COLONS
SKIPN T1,DTAFIL+FILDEV;WHILE WE HAVE THE CHANCE, LET'S MAKE SURE WE HAVE
POPJ P, ;IF NOTHING SPECIFIED, DON'T DO ANYTHING
DEVCHR T1, ;MAKE SURE WE HAVE A DECTAPE
TXNN T1,DV.DTA ;CAUSE OTHERWISE, WE'LL LOOK RATHER FOOLISH!
EDISIX [CPOPJ##,,[SIXBIT\? %: &IS NOT A &DEC&TAPE#!\]
WNAME DTAFIL+FILDEV]
PUSH P,IFILE## ;SAVE INPUT STREAM
FIGET DTAFIL ;OPEN DECTAPE
USETI DTA,DIRADR ;READY TO READ DIRECTORY
IN DTA,[IOWD DIRSIZ,DIRBLK
0] ;AND READ IT.
SKIPA T1,[DIRBLK] ;NO ERROR. GET DIRECTORY ADDR AND SKIP ERROR REPORTER
DISIX [DTAREL,,[SIXBIT\%!\];THIS IS A CUTE USE FOR DISIX...
ERRIN DTAFIL] ;REPORT INPUT ERROR AND PUNT
PUSHJ P,PRTDIR ;READ, PRINT DIRECTORY
TXNN F,LSTOPN ;IS OUTPUT REDIRECTED?
OUTPUT TTY, ;NO, FORCE OUT NOW FOR NEATNESS
DTAREL: TXNE F,UNLOAD ;SHOULD TAPE BE DISMOUNTED?
MTAPE DTA,11 ;YES, DO IT (USED WITH /PAUSE, USUALLY)
FREL DTAFIL ;NOW CAN RELEASE THE DTA
PJRST IPOPJ ;PROBABLY SHOULD BE EXTERNAL
DTAOPN: ERRIOP DTAFIL ;HERE IF FIGET FAILS. SAY SO
IPOPJ: POP P,IFILE## ;RESTORE INPUT STREAM
POPJ P, ;AND JUST IGNORE IT
A.FINI: TXZ F,FSTDIR!UNLOAD ;ENSURE WE START LONG AND LEAVE THE TAPE UP
POPJ P,
;SWITCH PROCESSOR. ENTER WITH DATA FROM A.SIXS
;T1/ NAME TYPED
;T2/ BYTE POINTER TO LAST BYTE
;THERE ARE 3 TABLES USED HERE:
;SWITTB SWITCH NAMES PASSED TO SIXSRC TO DECIDE ON LEGALITY OF TYPED
; TYPED SWITCH
;SWITBT TABLE OF BITS TO SET ON SWITCH MATCH
;SWITDP LEXTAB ADDRESS TO DISPATCH TO PARSING REST OF SWITCH.
A.SWIT: LDB T3,[POINT 6,T2,5];EXTRACT POSITION
SETO T2, ;READY TO MAKE MASK
LSH T2,(T3) ;POOF
MOVE T3,[-SWITN,,SWITTB];AOBJN WORD TO LIST OF NAMES
PUSHJ P,SIXSRC ;TRY TO FIND IT
JRST SWTBAD ;ERROR OF SOME SORT...PUNT
IOR F,SWITBT(T3) ;SET THE NECESSARY SWITCHES
SKIPA T1,SWITDP(T3) ;GET ADDRESS OF NEXT PRODUCTION
SWTBAD: MOVEI T1,SWITER ;BAD SWITCH, SAY SO
PJRST A.JUMP## ;AND DISPATCH THERE
A.PAUS: MONRT. ;/PAUSE - JUST STOP AND LET PEOPLE CHANGE DECTAPES
POPJ P, ;IT IS QUESTIONABLE AS TO WHETHER OR NOT THIS IS USEFUL.
SUBTTL COMMAND FILE PROCESSOR
;COMMAND FILE PROCESSOR AND INPUT SCANNER
;THE SYMBOL 'CMDLVL' MUST BE SET TO 0 BEFORE THE FIRST
;COMMAND FILE MAY BE PROCESSED AND IMPLIES THAT CMDEOF WILL REQUIRE
;THAT CMDFLB HAVE A THE BASE FILE ENTRY FIRST BEFORE THE COMMAND FILE BLOCK
;ADDRESSES
A.ACAL: AOS T1,CMDLVL ;BUMP CMD FILE LEVEL
CAILE T1,CMDDEP ;EXCEEDED CMD FILE NESTING DEPTH?
EDISIX [CMDEXC,,[SIXBIT\?C&OMMAND FILE NESTING TOO DEEP#!\]]
MOVE FB,CMDFLB(T1) ;GET ADDRESSES OF FILE BLOCKS (HISEG,,LOSEG)
FSETUP (FB) ;SETUP LOSEG FILE BLOCK
HLRZ FB,FB ;AND POINT TO IT FOR FILSPC
PJRST A.CALL## ;AND GO TO IT
A.DCMD: FIOPEN (FB) ;READ THE CMD FILE
RCH T1 ;'PRIME' PARSER. THIS IS NECESSARY BECAUSE
; IS ALWAYS ONE CHARACTER AHEAD OF US. SEE EITHER
; LEXINT OR THE TULIP MANUAL FOR GORY DETAILS
POPJ P, ;AND REDIRECT INPUT
;VARIOUS COMAND FILE ERROR ROUTINES THAT PUNT PROCESSING
CMDLK: ERRLK (FB) ;HERE ON LOOKUP ERROR, REPORT IT
JRST CMDFER ;AND WIPE OUT TRACES OF OUR PRESENCE
REPEAT 0,< ;LEAVE OUT BECAUSE WE CANNOT HANDLE INPUT ERRORS
;SINCE WE ARE COME HERE FROM WITHIN LEXINT AND HAVE
;NO IDEA AS TO WHAT THE STACK IS LIKE.
CMDIN: ERRIN @IFILE## ;REPORT ERROR (IFILE HAS ADDRESS OF INPUT FILE BLOCK)
JRST CMDFER ;AND AGAIN WIPE OUT TRACES
>
CMDOPN: ERRIOP (FB) ;REPORT
CMDEXC: SOSG T1,CMDLVL ;DON'T HAVE TO CLOSE THIS LEVEL, AS NEVER WAS OPENED
JRST CMDFIN ;IN FACT, IF AT TOP LEVEL, WE'RE ALL SET
CMDFER: MOVE T1,CMDLVL ;GET CURRENT LEVEL FOR ALL OTHER ERRORS
CMDELP: HLRZ T1,CMDFLB(T1) ;GET ADDRESS OF LOSEG FILE BLOCK
FICLOS (T1) ;CLOSE THAT
SOSLE T1,CMDLVL ;BACKUP ANOTHER
JRST CMDELP ;MORE TO GO, CLOSE THIS ONE
CMDFIN: HLRZ T1,CMDFLB-0 ;GET ADDRESS OF TTY IO BLOCK (OR WHATEVER)
FISEL (T1) ;AND POINT TO IT
JRST SWTBAD ;SAY THAT THIS SWITCH DIDN'T MAKE IT.
;ROUTINE CALLED TO INPUT EACH CHARACTER FROM COMMAND COMMAND FILE. IT WILL
;ALLOW ONLY ONE LINE SINCE EOF TRAPPING WILL NOT STORE THE PC OF THE
;UUO, SO THE PROGRAM HAS NO IDEA OF WHERE THE UUO WAS TO ATTEMPT
;TO REDO IT. IF WE REALLY WANTED TO ALLOW A WHOLE FILE AS A COMMAND FILE
;WE COULD DO ALL THE IO OURSELVES WITHOUT TOO MUCH TROUBLE!
CMDCHR: PUSHJ P,I1BYTE## ;GET A CHAR
JUMPE U1,CMDCHR ;IGNORE NULLS
CAIE U1,CR ;STOP ON A CRLF (CMD FILE ONLY 1 LINE)
POPJ P, ;GOT ONE WE CAN USE
FICLOS @IFILE## ;CLOSE THIS FILE
SOS U2,CMDLVL ;BACKUP ONE
HLRZ U2,CMDFLB(U2) ;GET ADDRESS OF LOSEG BLOCK
FISEL (U2) ;BACK TO IT
EXCH U1,T1 ;SWITCH THESE SO WE CAN
CCH T1 ;GO BACK TO LAST CHARACTER FROM THIS FILE
EXCH U1,T1 ;SINCE CAN'T DO IO TO U1
POPJ P, ; CONTINUE PROCESSING
SUBTTL FILE SPECIFIER ROUTINES
A.FILI: TXZA F,PRSDFL ;ALL WE NEED DO IS NOTE WE HAVEN'T SEEN A FILENAME
A.DEV: MOVEM T1,FILDEV(FB) ;SAVE DEVICE NAME
POPJ P, ;THESE ROUTINES ARE OFTEN THIS SHORT!
A.NAME: ;GOT NAME, PRSDFL WILL BE OFF AND MUST BE SET
A.NAMX: TXOE F,PRSDFL ;SET FILE SEEN FLAG AND CHECK TO SEE IF IT WAS
JRST A.EXT ;YES, MUST BE EXTENSION
MOVEM T1,FILNAM(FB) ;SAVE FILE NAME
POPJ P,
A.EXT: MOVEM T1,FILEXT(FB) ;SAVE EXTENSION
POPJ P,
A.PROJ: HRLZM T1,FILPPN(FB) ;SAVE PROJECT (LEFT HALF)
PJRST A.CALL## ;AND FAKE A CALL FOR THE OTHER HALF
A.PROG: HRRM T1,FILPPN(FB) ;AND REMEMBER IT
POPJ P, ;BEFORE RETURNING
;ROUTINE TO HANDLE DATA FLOW WHILE PARSING A SIXBIT WORD. RETURNS:
; T1/ SIXBIT DATA
; T2/ BYTE POINTER POINTING TO LAST BYTE
A.SIXS: TRNE P3,LGLSIX ;THIS IS CUTE. WE MAY HAVE ONE OF 3 TYPES OF CHARS:
;NUM, RANGE 60-71 (SIXBIT 20-31)
;UC, RANGE 101-132 (41-72)
;LC, RANGE 141-172 (41-72)
;SO, IF IT IS LEGAL SIXBIT, WE HAVE TO COMPLEMENT
;BIT 40:
XORI P2,40 ;LIKE THAT, WHILE LEAVING LOWER CASE ALONE
TLNE T2,770000 ;MORE CUTENESS. THIS FIELD IS 0 AFTER T1 IS FILLED
IDPB P2,T2 ;STUFF INTO T1
POPJ P, ;AND BACK FOR MORE
A.SIXI: MOVE T2,[POINT 6,T1] ;SETUP POINTER TO WHERE WE'LL ACCUMULATE THE NAME
A.OCTI: SETZ T1, ;AND CLEAR THAT OF ANY GARBAGE IT MIGHT HAVE
POPJ P, ;BACK TO SCAN FIRST CHARACTER
;ROUTINE TO SCAN AN OCTAL NUMBER, RETURNS WITH THE NUMBER IN T1
A.OCTS: LSH T1,3 ;MAKE ROOM
IORI T1,-"0"(P2) ;MERGE IN
POPJ P, ;SIMPLE
SUBTTL UTILITY SUBROUTINES
;SUBROUTINE TO PRINT CURRENT DATE AND TIME AS
; 'ON <DATE> AT <TIME>'
;USES T1-T4
DATTIM: DISIX [CPOPJ##,,[SIXBIT\&ON % AT %!\];PRINT DATE, TIME, THEN RETURN
PUSHJ P,DATPRT ;PRINT CURRENT DATE
PUSHJ P,TIMPRT];PRINT CURRENT TIME
;SUBROUTINE TO PRINT EITHER CURRENT DATE (ENTER AT DATPRT) OR DATE
;PASSED IN T1 (ENTER AT DATTHN). USES T1-T3
DATPRT: DATE T1, ;GET TODAY'S DATE
DATTHN: IDIVI T1,^D<12*31> ;T1_YEAR-64
IDIVI T2,^D< 31> ;T2_MONTH-1, T3_DAY-1
WDECI 2,1(T3) ;DAY
WNAME MONTAB(T2) ;.MONTH.
WDECI ^D64(T1) ;AND YEAR
POPJ P, ;AND RETURN
;SUBROUTINE TO PRINT TODAYS TIME. USES T1-T3, EXITS WITH LZEFLG OFF
TIMPRT: MSTIME T1, ;TOP OFF WITH TIME
IDIVI T1,^D1000 ;DISCARD THOUSANTHS
IDIVI T1,^D<60*60> ;T1_HOURS
IDIVI T2,^D< 60> ;T2_MINUTES; T3_SECONDS
TXO F,LZEFLG ;PRINT TIME WITH LEADING ZEROS
DISIX [[SIXBIT\%:%:%!\]
WDEC 2,T1 ;HOURS
WDEC 2,T2 ;MINUTES
WDEC 2,T3] ;SECONDS
TXZ F,LZEFLG ;TURN OFF AS PROMISED
POPJ P, ;AND RETURN
COMMENT \ROUTINE TO SCAN A SIXBIT LIST LOOKING FOR EXACT OR PARTIAL MATCH
ENTER WITH
T1/ SIXBIT NAME TYPED
T2/ MASK TO USE
T3/ AOBJN WORD POINTING TO A TABLE OF SIXBIT NAMES
INTERNAL USE:
T1-T3 - AS ABOVE
T4/ TEMPORARY (CURRENT NAME AND ABBREVIATION
P1/ COROUTINE PC
P2/ USED BY COROUTINE CODE...SEE COMMENTS THERE
RETURNS
T1/ NAME TYPED
T2/ MASK
T3/ RH - RELATIVE INDEX FOR COMMAND (NOT ADDRESS!!)
IF THERE ARE ANY SHORT COMMANDS THAT ARE ABBREVIATIONS OF LONGER ONES,
THEY MUST PRECEDE THE LONG ONE OR ELSE SIXSRC WILL BECOME QUITE CONFUSED,
E. G. IF FOOBAR AND FOONLY PRECEDED FOO, AND SIXSRC WAS ASKED TO SCAN
FOR FOO, AN ERROR MESSAGE WILL RESULT COMPLAINING THAT FOOBAR AND FOONLY ARE
AMBIGUOUS YET SIXSRC WILL TAKE THE SUCCESSFUL RETURN SINCE FOO IS AN
EACT MATCH.\
SIXSRC: PUSHJ P,SAVE2## ;4 TEMP ACS NOT ENOUGH HERE
HRLM T3,(P) ;SAVE TABLE ADDR SO WE CAN RETURN CMD INDEX
MOVEI P1,SIXMAT ;SETUP COROUTINE ADDR
SIXS1: MOVE T4,(T3) ;GET REAL COMMAND NAME
CAMN T1,T4 ;EXACT MATCH?
JRST SIXS2 ;YES, WE HAVE WHAT WE WANT!
AND T4,T2 ;TRIM NAME DOWN TO SIZE (OF WHAT WAS TYPED)
CAMN T1,T4 ;NOW DOES IT MATCH?
JSP P1,(P1) ;CALL COROUTINE TO DETERMINE CORRECTNESS
; OF THIS MATCH
AOBJN T3,SIXS1 ;GO TRY ANOTHER
CJSP1: JSP P1,1(P1) ;DONE. LET AMBIGUOUS CHECKER FINISH UP IF NECESSARY
SIXS2: AOS (P) ;THE JSP WILL DO A SKIP RETURN IF ERROR
HLRZ T4,(P) ;GET SWITCH TABLE ADDRESS BACK
SUB T3,T4 ;MAKE T3 BE INDEX. NOTE THAT T3 WILL BE
; GARBAGE IF WE WILL TAKE THE ERROR RETURN.
POPJ P, ;TELL CALLER HOW WE DID
COMMENT \
COROUTINE USED TO HANDLE PARTIAL MATCHES FOUND BY SIXSRC. THIS SCHEME ALLOWS
BOTH THE EASE OF A LOOP TO SEARCH A LIST WHILE AT THE SAME TIME ALLOWING THE
EASE OF A COROUTINE TO BE USED INSTEAD OF INCREMENTING AND CHECKING AN
EVENT COUNTER.
THE COROUTINE IS CALLED BY EITHER:
JSP P1,(P1) ;FOR EACH MATCH DETECTED. THE FIRST
TIME IT IS CALLED, THE FIRST MATCH WILL HAVE BEEN FOUND AND MAY
REPRESENT A VALID MATCH. NOT UNTIL THE THE SECOND CALL MAY IT REPORT
AN ERROR, AND THEN IT MUST REPORT 2 OF THEM SINCE 2 MATCHES WILL
HAVE OCCURED. ALL FUTURE CALLS WILL HAVE TO REPORT ONE ERROR.
JSP P1,1(P1) ;AT THE END OF SIXSRC. THE COROUTINE IS
QUERIED AS TO WHAT IT HAS FOUND AND MUST DO A SKIP RETURN IF A BAD
(AMBIGUOUS OR NONEXISTANT) NAME WAS SEARCHED FOR. THIS CALL ALSO ALLOWS
SIXMAT TO FINISH ANY ERROR REPORTING IF NECESSARY. IF
THIS IS THE FIRST CALL TO SIXMAT, NO MATCHES HAVE BEEN FOUND AND
SIXMAT REPORTS SO. IF THIS IS THE SECOND CALL, THEN PRECISELY
ONE MATCH HAS BEEN FOUND, AND THE NON-SKIP RETURN IS TAKEN TO
SIGNIFY SUCCESS WITH T3 POINTING TO THE COMMAND.
IF THIS THE THIRD OR GREATER CALL, THEN THE AMBIGUOUS
ERROR MESSAGE IS FINISHED WITH A ')'. IN THE CASE OF THE SUCCESSFUL
RETURN, ACCUMULATOR T3 WILL BE SETUP WITH ADDRESS OF MATCHED SWITCH.
THE CJSP1 LABEL BACK IN SIXSRC IS SIMPLY A MEANS TO SAVE AN INSTRUCTION
HERE. IT MAY BE USED SINCE THE COROUTINE WILL BE CALLED NO LONGER.
ALL WE NEED TO DO IS A SKIP RETURN, AND A JSP DOES IT QUITE WELL.
COROUTINES ARE NEAT!\
SIXMAT: JRST SIXMA1 ;FIRST MATCH, NOTHING TO WORRY ABOUT
EDISIX [CJSP1,,[SIXBIT\? % &IS NOT DEFINED.#!\]
WNAME T1] ;IDENTIFY IT
SIXMA1: MOVE P2,T3 ;REMEMBER MATCH IN CASE OF SUCCESSFUL RETURN
; AND FOR AMBIGUOUS ERROR CODE BELOW
JSP P1,(P1) ;FROM SIXERR. JUST GO GET SOME MORE
EDISIX [SIXAMB,,[SIXBIT\? % IS AMBIGUOUS (%, %!\]
WNAME T1 ;SWITCH HE TYPED
WNAME (P2) ;LAST MATCH
WNAME (T3)] ;THIS MATCH
MOVEI T3,(P2) ;HERE FROM END OF SIXSRC TO WHEN WE FOUND JUST
; THE ONE MATCH WE WERE HOPING FOR.
; RETURN T3/ ADDR OF MATCH
SIXAMB: JSP P1,(P1) ;DO COROUTINE CALL BACK TO CALLER
EDISIX [SIXAMB,,[SIXBIT\, %!\];HERE FOR 3RD OR GTR MATCH
WNAME (T3)] ;CURRENT MATCH
EDISIX [CJSP1,,[SIXBIT\)#!\]]
SUBTTL HISEG DATA BASE
DEFINE MAKLST (A)<
IRP A<SIXBIT/.'A'./>>
MONTAB: MAKLST <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
DEFINE SWITCH< ;;MACRO OF ALL SWITCHES
XLIST ;;I THINK WE CAN DO WITHOUT ALL THIS DATA
XX(SHORT ,FSTDIR,SHRTSW);;FORMAT: NAME,BITS TO SET,NEXT PROD
XX(F ,FSTDIR,SHRTSW);;ALLOW SEVERAL NAMES TO MAKE THIS BIGGER
XX(FAST ,FSTDIR,SHRTSW);;AND BETTER!
XX(L ,0 ,SHRTSW);;THIS TO ALLOW PIP CMD STRING
XX(COMMAN,0 ,CMDFSW);;COMMAND FILE SWITCHES
XX(CMD ,0 ,CMDFSW)
XX(AUTO ,0 ,CMDFSW)
XX(PAUSE ,0 ,PAUSSW);;PAUSE TO REMOUNT DTAS
XX(UNLOAD,UNLOAD,SHRTSW);;DISMOUNT TAPE AFTER DIRECTORY
LIST ;;TURN LISTING BACK ON
>
DEFINE XX(A,B,C)<<SIXBIT /A/>>
SWITTB: SWITCH ;NAMES OF SWITCHES
SWITN==.-SWITTB
DEFINE XX(A,B,C)<EXP B>
SWITBT: SWITCH ;BIT TABLE
DEFINE XX(A,B,C)<EXP C>
SWITDP: SWITCH ;DISPATCH TABLE
CMDDEP==20-CMD0 ;CMD0 AND ABOVE ARE IO CHANNELS RESERVED FOR CMD FILES
%Z==0 ;SETUP FOR BELOW
REPEAT CMDDEP-1,<CONC < GETCHN(CMD>,\<%Z==%Z+1>,<)>>
DEFINE CMDGEN<
XLIST ;;NO NEED TO SEE ALL THIS
%Z==0 ;;START WITH THE FIRST COMMAND BLOCK
REPEAT CMDDEP,< CMDSUB(\%Z)
%Z==%Z+1 ;;STEP TO NEXT
> LIST
>
DEFINE CMDSUB(N)<
C'N'FIL,,C'N'FIH
>
CMDFLB: TTYFIL,,TTYFIH ;CREATE LOSEG FILE BLOCK VECTOR, WHICH STARTS WITH
CMDGEN ; BASE FILE STREAM BEFORE THE COMMAND FILES
DEFINE CMDSUB(N)<
C'N'FIH: FILE CMD'N,I,C'N'FIL,<DEV(DSK),EXT(CMD),<INST(<PUSHJ P,CMDCHR>)>,OPEN(CMDOPN),LOOKUP(CMDLK)>>
CMDGEN ;DEFINE ALL HISEG FILE BLOCKS FOR COMMAND FILES
DTAFIH: FILE DTA,I,DTAFIL,<DEV(),STATUS(IO.NSD!.IODMP),OPEN(DTAOPN)>
TTYFIH: FILE TTY,I,TTYFIL,<DEV(TTY),OTHER(TTYFOL),EOF(TTYEOF)>
TTYFOH: FILE TTY,O,TTYFOL,<DEV(TTY),OTHER(TTYFIL)>
LSTFOH: FILE LST,O,LSTFOL,<NAME(DTDIR),EXT(LST)>
SUBTTL LOW SEGMENT DATA BASE
RELOC 0 ;POINT TO LOWSEG DATA
DEFINE CMDSUB(N)<
C'N'FIL: BLOCK FBSIZE
>
CMDGEN ;ALLOCATE SPACE FOR LOSEG BLOCKS
CMDLVL: BLOCK 1 ;LEVEL OF CMD FILES
DTAFIL: BLOCK FBSIZE ;CORRESPONDING LOSEG BLOCK FOR DTAFIH
TTYFIL: BLOCK FBSIZE ; AND FOR THE REST
TTYFOL: BLOCK FBSIZE
LSTFOL: BLOCK FBSIZE ;AREA FOR LIST FILE BLOCK
DIRBLK: BLOCK DIRSIZ ;WHERE WE READ DIRECTORY
SJBFF: BLOCK 1 ;AREA TO KEEP OLD .JBFF
FREFIL: BLOCK 1 ;WHERE WE PUT # OF FREE FILES
FILSIZ: BLOCK 40 ;NEED 40 ENTRIES FOR ANY BYTE SIZE
PDL: BLOCK PDLLEN
RELOC ;BACK TO HISEG FOR LITERALS
END TULIP4