Trailing-Edge
-
PDP-10 Archives
-
bb-bt99l-bb
-
parse.mac
There are 11 other files named parse.mac in the archive. Click here to see a list.
TITLE INDIR
SEARCH PRS,UUOSYM
TWOSEG
RELOC 0
SPC: BLOCK SPCSIZ ;FILESPEC OF INDIRECT FILE
RELOC 400000
ENTRY INDIR
EXTERN CI,ICH,FNDCH,LKP,ICLS,SPCI,EATCR,BP,PRSSYN,CPOPJ1
INDIR: CAIE C,"@" ;INDIRECT?
POPJ P, ;NO
PUSHJ P,CI ;YES, EAT "@"
POPJ P,
PUSH P,P1 ;SAVE P1
PUSHJ P,PSPC ;PARSE THE SPEC
JRST INDDN2
PUSH P,ICH ;SAVE INPUT CH
PUSHJ P,FNDCH ;ALLOCATE A CH
HALT
PUSH P,T1 ;SAVE IT ON STACK
MOVEM T1,ICH ;AND SELECT IT
MOVEI P1,SPC ;OPEN THE FILE
PUSHJ P,LKP
JRST INDDON
INDLOP: MOVE T1,(P) ;SELECT THE CHANNEL
MOVEM T1,ICH
PUSHJ P,CI ;INPUT 1ST CHAR
JRST INDDON
PUSHJ P,@-3(P) ;LET USER PARSE THIS LINE
JFCL
JRST INDLOP
INDDON: POP P,ICH ;CLOSE THE FILE
PUSHJ P,ICLS
POP P,ICH ;RESTORE ORIGINAL CH
INDDN2: POP P,P1 ;RESTORE P1
POP P,T1 ;PUSHJ P,INDIR
POPJ P,
PSPC: SETZM SPC ;BUILD DEFAULT SPEC
MOVE T1,[XWD SPC,SPC+1]
BLT T1,SPC+SPCSIZ-1
MOVSI T1,SPCSIZ
MOVEM T1,SPC+.SBSIZ
MOVSI T1,'DSK'
MOVEM T1,SPC+.SBDEV
HRROI T1,.GTPRG
GETTAB T1,
MOVSI T1,'SPC'
MOVEM T1,SPC+.SBNAM
MOVSI T1,'CMD'
MOVEM T1,SPC+.SBEXT
MOVEI T1,.IOASC
MOVEM T1,SPC+.SBMOD
MOVEI P1,SPC ;PARSE THE SPEC
PUSHJ P,SPCI
POPJ P,
PUSHJ P,EATCR ;TEST FOR BREAK CHAR
POPJ P,
PUSHJ P,BP
JRST PRSSYN
JRST CPOPJ1
PRGEND
TITLE SWINI - READ SWITCH.INI
;THIS ROUTINE WILL READ SWITCH.INI ON A FREE CH AND PARSE THE SWITCHES
;ENTER WITH P2 AND P3 SET UP FOR SWTCH
;RETURNS CPOPJ IF I/O ERROR IN SWITCH.INI
;ELSE RETURNS CPOPJ1
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY SWINI
EXTERN EATCR,PRSSYN,BP,CPOPJ1
EXTERN SAVE1,ICH,FNDCH,FOO,SLKP,CI,ICLS,EATEOL,SIXI,SWTCH
SWINI: PUSHJ P,SAVE1 ;SAVE P1
PUSH P,ICH ;SAVE INPUT CH
PUSHJ P,FNDCH ;FIND A FREE CH
HALT
MOVEM T1,ICH
PUSH P,C ;SAVE CHAR
SETZM FOO ;CLEAR FOO
MOVE T1,[XWD FOO,FOO+1]
BLT T1,FOO+FOOSIZ-1
HRLZI T1,'DSK' ;SET UP FILESPEC
MOVEM T1,FOO+.SBDEV
HRLZI T1,'INI'
MOVEM T1,FOO+.SBEXT
MOVE T1,[SIXBIT /SWITCH/]
MOVEM T1,FOO+.SBNAM
HRROI T1,.GTPPN
GETTAB T1,
HALT
MOVEM T1,FOO+.SBPPN
MOVEI T1,.IOASC
MOVEM T1,FOO+.SBMOD
MOVEI P1,FOO ;LOOKUP THE FILE
PUSHJ P,SLKP
JRST WIN
HRROI P1,.GTPRG ;PROGRAM TO LOOK FOR
GETTAB P1,
HALT
SWLOP: PUSHJ P,CI ;INPUT 1ST CHAR
JRST SWINI9
PUSHJ P,SIXI ;INPUT THE PROGRAM NAME
JRST LOOSE
CAMN P1,T1 ;OUR NAME?
JRST SWFND ;YES, WE FOUND IT
PUSHJ P,EATEOL ;NO, EAT THE LINE
JRST LOOSE
JRST SWLOP ;KEEP LOOKING
SWFND: PUSHJ P,SWTCH ;PROCESS THE SWITCHES
JRST LOOSE
PUSHJ P,EATCR ;TEST FOR BREAK CHAR
JRST LOOSE
PUSHJ P,BP
JRST LOOSE
JRST WIN
LOOSE: TRON C,IO.ERR ;TYPED AN ERROR MESSAGE YET?
PUSHJ P,PRSSYN ;NO, USE THE CATCH ALL
SWINI9: TRNE C,IO.ERR ;EOF OR ERROR?
SOS -2(P) ;ERROR, NOSKIP RETURN
WIN: PUSHJ P,ICLS ;CLOSE SWITCH.INI
POP P,C ;RESTORE THE CHAR
POP P,ICH ;RESTORE THE CH
JRST CPOPJ1
PRGEND
TITLE VERBO - OUTPUT A VERBOSITY ERROR MESSAGE
;CALL:
; MOVEI T1,FOO
; PUSHJ P,VERBO
; ETC
; ADDR2
; ADDR1
;FOO: XWD BITS,"?"
; SIXBIT /PREFIX/
; ASCIZ /FIRST/
;WHERE THE FIRST OCCURENCE OF "^" IN FIRST CAUSES VERBO TO DO A
;PUSHJ TO ADDR1. IT IS ASSUMED THAT ADDR1 IS THE ADDRESS OF A ROUTINE
;THAT WILL TYPE OUT SOME VARIABLE PART OF THE ERROR MESSAGE.
;THE SECOND OCCURENCE OF "^" CAUSES VERBO TO DO A PUSHJ TO ADDR2. ETC.
;ARGS CAN BE PASSED FROM THE CALLER OF VERBO TO THE ADDRN ROUTINE IN P1.
;P1 IS PRESERVED THROUGH VERBO FOR THIS PURPOSE.
;THE ADDRN ROUTINE MAY RETURN CPOPJ OR CPOPJ1,
;BUT VERBO ALWAYS RETURNS CPOPJ
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY VERBO
EXTERN OCH,SAVE3,SIXO,CRLFO,CO,CPOPJ
VERBO: SETOM OCH ;OSELECT TTY
PUSHJ P,SAVE3 ;SAVE P1-P3
MOVE P2,T1 ;COPY ARG
HRROI P3,.GTWCH ;GET VERB BITS
GETTAB P3,
SETZ P3,
TLNN P3,(JW.WPR+JW.WFL)
HRLZI P3,(JW.WPR+JW.WFL)
PUSHJ P,CRLFO
HALT
MOVE T1,(P2) ;EAT TYPE AHEAD?
TLNE T1,(ER.EAT)
CLRBFI ;YES
HRRZ C,T1 ;TYPE "%" OR "?"
PUSHJ P,CO
HALT
MOVE T1,1(P2) ;GET PREFIX
TLNE P3,(JW.WPR) ;PREFIX?
PUSHJ P,SIXO ;YES, TYPE IT
JFCL
TLNN P3,(JW.WFL) ;FIRST?
POPJ P,
MOVEI C," "
PUSHJ P,CO
HALT
MOVEI P3,2(P2) ;YES, TYPE IT
HRLI P3,(POINT 7)
VERBO8: ILDB C,P3 ;GET NEXT CHAR
JUMPE C,CPOPJ ;QUIT IF EOS
CAIN C,"^" ;SPECIAL?
JRST VERBO9 ;YES
PUSHJ P,CO ;NO
HALT
JRST VERBO8
VERBO9: PUSHJ P,@-1(P2) ;FILL IN THE BLANK
JFCL
SOJA P2,VERBO8 ;BACK PNTR UP AND GO FOR MORE
PRGEND
TITLE SPCSI - PARSE A STRING OF FILE SPECS
;P1 PASSES ADR OF 1ST SPC (DESTROYED)
;SPC MUST BE PRE-LOADED WITH DEFAULTS
;P2+P3 PASS SWITCH ARGS
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SPCSI
EXTERN SPCI,SWTCH,EATS,CPOPJ1,CI,GETBLK
SPCSI: PUSHJ P,SPCI ;GET FILE SPEC
POPJ P,
PUSHJ P,SWTCH ;DO SWITCHES
POPJ P,
PUSHJ P,EATS ;ANOTHER SPC COMING?
POPJ P,
CAIE C,","
JRST CPOPJ1 ;NO
PUSHJ P,CI ;YES, EAT THE COMMA
POPJ P,
HLRZ T1,.SBSIZ(P1) ;GET CORE FOR ANOTHER SPC
PUSHJ P,GETBLK
POPJ P,
ADD T1,T2 ;STICKY DEFAULTS
HRLZ T3,P1
HRR T3,T2
BLT T3,-1(T1)
HRRM T2,.SBNXT(P1) ;APPEND TO LINK LIST
MOVE P1,T2
JRST SPCSI ;GO GET THE SPC
PRGEND
TITLE LSTI - INPUT A SIXBIT LIST
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY LSTI
EXTERN CI,EATS,GETBLK,WSIXI,CPOPJ1,PRSSYN
LSTI: PUSHJ P,EATS ;EAT SPACES
POPJ P,
SETZ P1, ;0 MEANS END OF LIST
CAIE C,"(" ;REAL LIST OR JUST 1?
JRST LSTESY ;ONE
LSTLOP: PUSHJ P,CI ;EAT IT
POPJ P,
PUSHJ P,LSTESY ;GET ONE ITEM
POPJ P,
PUSHJ P,EATS ;EAT SPACES
POPJ P,
CAIN C,"," ;ANOTHER COMING?
JRST LSTLOP ;YES
CAIE C,")" ;NO, BETTER BE END
JRST PRSSYN
JRST CI ;EAT THE RIGHT
LSTESY: MOVEI T1,3 ;GET A CORE BLOCK
PUSHJ P,GETBLK
POPJ P,
HRRM P1,(T2) ;LINK IT TO FRONT OF LIST
MOVE P1,T2 ;NEW FRONT
PUSHJ P,WSIXI ;GET A SIXBIT WORD
POPJ P,
MOVEM T1,1(P1) ;STORE IT
MOVEM T2,2(P1)
JRST CPOPJ1
PRGEND
TITLE EXT - EXIT SWITCH
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY EXT
EXTERN EATEOL
EXT: PUSHJ P,EATEOL ;EAT UNTIL EOL
HALT
EXIT
PRGEND
TITLE EATEOL - EAT UNTIL EOL
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY EATEOL
EXTERN CI,BP,CPOPJ1
EATEO2: PUSHJ P,CI ;EAT IT
POPJ P,
;ENTER HERE
EATEOL: PUSHJ P,BP ;BREAK CHAR?
JRST EATEO2 ;NO
JRST CPOPJ1 ;YES
PRGEND
TITLE HELPER - HELP SWITCH
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY HELPER
EXTERN SAVE1,ICH,FNDCH,FOO,LKP,GETC,ICLS
HELPER: PUSHJ P,SAVE1 ;SAVE P1
PUSH P,ICH ;SAVE INPUT CH
PUSHJ P,FNDCH ;FIND A FREE CH
HALT
MOVEM T1,ICH ;ISELECT IT
PUSH P,C ;SAVE CHAR
SETZM FOO ;CLEAR FOO
MOVE T1,[XWD FOO,FOO+1]
BLT T1,FOO+FOOSIZ-1
HRLZI T1,'HLP' ;HLP:*.HLP
MOVEM T1,FOO+.SBDEV
MOVEM T1,FOO+.SBEXT
HRROI T1,.GTPRG ;GET PROGRAM NAME
GETTAB T1,
HALT
MOVEM T1,FOO+.SBNAM
MOVEI T1,.IOASC
MOVEM T1,FOO+.SBMOD
MOVEI P1,FOO ;LOOKUP THE FILE
PUSHJ P,LKP
JRST HLPDON
HLPLOP: PUSHJ P,GETC ;INPUT A CHAR
JRST HLPDON
OUTCHR C ;OUTPUT IT
JRST HLPLOP
HLPDON: PUSHJ P,ICLS ;RELEASE CH
POP P,C ;RECALL CHAR
POP P,ICH ;RECALL INPUT CH
POPJ P,
PRGEND
TITLE RST - RESET
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY RST
EXTERN FREMEM,RNGHDR
RST: RESET ;MONITOR DOES MOST
SETZM FREMEM ;NO FREE BLOCKS
SETZM RNGHDR ;CLEAR RING HDR TABLE
MOVE T1,[XWD RNGHDR,RNGHDR+1]
BLT T1,RNGHDR+17
POPJ P,
PRGEND
TITLE SWTCH - PARSE SWITCHES
;P2 PASSES AOBJN POINTER TO TABLE OF SWITCH NAMES
;P3 PASSES ADR OF TABLE OF ONE INSTRUCTION ROUTINES
;SWTCH WILL XCT THE INSTRUCTION CORRESPONDING TO THE SWITCH NAME.
;IF ONE INSTRUCTION ISN'T ENOUGH, USE A PUSHJ TO A SUBROUTINE.
;THE SUBROUTINE IS EXPECTED TO PRESERVE P1-P4, BUT MAY DESTROY T1-T4.
;THE SUBROUTINE IS EXPECTED TO RETURN CPOPJ.
;CPOPJ1 WILL BE REGARDED AS AN ERROR RETURN,
;AND SWTCH WILL PASS THE ERROR TO ITS CALLER BY RETURNING CPOPJ.
;SWTCH NORMALLY RETURNS CPOPJ1.
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SWTCH
EXTERN EATS,CPOPJ1,CI,SIXI,FNDNAM
SWTCH: PUSHJ P,EATS ;EAT SPACES
POPJ P,
CAIE C,"/" ;ANY SWITCHES?
JRST CPOPJ1 ;NO
PUSHJ P,CI ;YES, EAT THE SLASH
POPJ P,
PUSHJ P,SIXI ;GET THE SWITCH NAME
POPJ P,
MOVE T2,P2 ;FIND IT IN TABLE
PUSHJ P,FNDNAM
POPJ P,
ADD T2,P3 ;XCT THE SWITCH
XCT (T2)
JRST SWTCH ;SWITCH WON, LOOK FOR ANOTHER
POPJ P, ;SWITCH LOST
PRGEND
TITLE WILDER - WILDCARD LOOKUP
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY WILDER
EXTERN WLDCNT,WILD,WLDNSF,CPOPJ1
WILDER: SETZM WLDCNT ;RESET COUNT
PUSHJ P,WILD ;WILDCARD LOOKUP
JFCL
SKIPN WLDCNT ;ANY FILES?
JRST WLDNSF ;NO
JRST CPOPJ1
PRGEND
TITLE WILD - WILDCARD LOOKUP
;P1 PASSES ADR FILE SPEC
;P2 PASSES ADR OF USER ROUTINE
;WILD WILL PUSHJ TO THE USER ROUTINE FOR EACH FILE MATCHED BY THE WILDCARD
;WHEN THE USER ROUTINE IS CALLED, P1 WILL STILL POINT TO THE FILE SPEC,
;BUT THE SPEC WILL HAVE BEEN MODIFIED TO REPRESENT THE PARTICULAR FILE
;THE USER ROUTINE MAY RETURN CPOPJ1 IF IT LIKES, NON-SKIP RETURNS
;ARE IGNORED
;WILD WILL RESTORE THE SPEC TO ITS ORG STATE BEFORE IT EXITS
;WILD MAY RETURN CPOPJ1 (MEANINGLESS)
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY WILD
EXTERN IINS,ICH,GETC,WILDP,WLDNSF,PRSIN,PRSOPN
EXTERN CPOPJ1,FOO,FNDCH,OPN,ICLS,CNVSPC,RNGHDR
EXTERN GETRNG,CPOPJ,PRSLKP,MYPATH,FIL,GETBLK,SLKP
DIRBLK=^D100 ;BLK OF DTA DIRECTORY
DTNAM=^D83 ;INDEX OF 1ST FILENAME IN DIR
DTNUM=^D22 ;FILES IN DIR
DTEXT=DTNAM+DTNUM ;INDEX OF 1ST EXT
WILD: PUSHJ P,WILDP ;ANY WILD CARDS?
JRST (P2) ;NO, JUST DO IT
SKIPE .SMDEV(P1) ;WILD DEVICE?
JRST AL ;YES, SUBSET OF ALL
MOVE T1,.SBDEV(P1) ;NO, GET DEVICE TYPE
DEVCHR T1,
TLNE T1,(DV.DTA) ;DEC-TAPE?
JRST DTA ;YES
TLNN T1,(DV.DSK) ;DISK?
JRST (P2) ;NO, NOT A DIRECTORY DEVICE
MOVE T1,.SBDEV(P1) ;YES, GET IT'S PATH
MOVEM T1,FOO
MOVE T2,[XWD FOOSIZ,FOO]
PATH. T2,
HALT
MOVE T1,FOO ;UNDONE LOGICAL NAME
MOVE T2,FOO+.PTSWT ;GET SWITCHES
LDB T3,[POINT 3,T2,29] ;GET SEARCH LIST TYPE
TRNN T2,PT.IPP ;ERSATZ?
JRST WILD1
MOVE T4,FOO+.PTPPN ;YES, OVER-RIDE USER PATH
MOVEM T4,.SBPPN(P1)
IFN SFDS,<
SETZM .SBPPN+1(P1)
>
SETZM .SMPPN(P1)
CAIN T3,.PTSLN ;ERSATZ WITH NO SEARCH LIST?
HRLI T1,'DSK' ;YES, USE THAT PPN ON DSKX
WILD1: MOVEM T1,.SBDEV(P1) ;PUT FINAL VERSION OF DEVICE BACK
CAMN T1,[SIXBIT /DSK/] ;IS IT DEFAULT DSK?
MOVEI T3,.PTSLJ ;YES, AVOID A MONITOR BUG
CAIN T3,.PTSLN ;NON-STANDARD SEARCH LIST
JRST WLD
CAIN T3,.PTSLJ ;JOB SEARCH LIST
JRST JOB
CAIN T3,.PTSLA ;ALL SEARCH LIST
JRST ALL
CAIN T3,.PTSLS ;SYS SEARCH LIST
JRST SYS
HALT
;JOB SEARCH LIST
JOB: SETOB T1,T2 ;OUR JOB, OUR PPN
JRST SYS1
;SYS SEARCH LIST
SYS: SETZ T1, ;SYS=JOB 0
SYS1: SETO T3, ;1ST STR IN SEARCH LIST
PUSH P,.SBDEV(P1) ;SAVE ORG DEVICE
PUSH P,.SMDEV(P1)
PUSH P,T1 ;SAVE GOBSTR ARG BLK IN STACK
PUSH P,T2
PUSH P,T3
SYSLOP: MOVEI T1,-2(P) ;GET NEXT STR
HRLI T1,3
GOBSTR T1,
HALT
SKIPN T1,(P)
JRST SYSDON ;FENCE
MOVEM T1,.SBDEV(P1) ;PASS IT TO USER
PUSHJ P,WLD ;DO WILD CARDS
JFCL
JRST SYSLOP ;TRY FOR ANOTHER STR
;ALL SEARCH LIST
ALL: SETOM .SMDEV(P1) ;MAKE ALL *
AL: PUSH P,.SBDEV(P1) ;SAVE ORG DEVICE
PUSH P,.SMDEV(P1) ;AND MASK
SETZM .SMDEV(P1) ;PASS NON-WILD MASK TO USER
TDZA T1,T1 ;1ST STR IN SEARCH LIST
ALLOP: MOVE T1,.SBDEV(P1) ;GET NEXT STR
SYSSTR T1,
HALT
JUMPE T1,ALLDON ;0 MEANS NONE LEFT
MOVEM T1,.SBDEV(P1) ;PASS IT TO USER
XOR T1,-1(P) ;MATCH WILD MASK?
ANDCM T1,(P)
JUMPN T1,ALLOP ;NO, TRY NEXT STR
PUSHJ P,WLD ;YES, DO WILDCARDS
JFCL
JRST ALLOP ;TRY FOR ANOTHER
;HERE WHEN SYS SEARCH IS DONE
SYSDON: POP P,T3 ;EAT GOBSTR ARG BLK
POP P,T2
POP P,T1
;HERE WHEN ALL SEARCH IS DONE
ALLDON: POP P,.SMDEV(P1) ;RESTORE MASK
POP P,.SBDEV(P1) ;RESTORE DEVICE
JRST CPOPJ1
;HERE WHEN DEVICE IS DEC-TAPE
DTA: HRRZ T1,.SMEXT(P1) ;ANY WILDCARDS?
IOR T1,.SMNAM(P1)
JUMPE T1,(P2) ;NO, JUST GOTO USER ROUTINE
PUSHJ P,FNDCH ;FIND A FREE CH
HALT
MOVEM T1,ICH ;ISELECT IT
MOVEI T1,3 ;GET A RING HDR
PUSHJ P,GETBLK
POPJ P,
MOVEM T2,OPN+.OPBUF
MOVE T1,.SBDEV(P1) ;AND BUILD OPEN BLK
MOVEM T1,OPN+.OPDEV
MOVEI T1,.IOIBN
MOVEM T1,OPN+.OPMOD
PUSHJ P,IINS ;OPEN IT
OPEN OPN
JRST PRSOPN
MOVE T3,ICH ;STORE ADR RING HDR
HRRZ T2,OPN+.OPBUF
HRRM T2,RNGHDR(T3)
PUSHJ P,GETRNG ;GET BUF RING
JRST ICLS
PUSHJ P,IINS ;WILL READ DIRECTORY BLOCK
USETI DIRBLK
PUSHJ P,IINS ;READ IT
IN
CAIA ;WIN
JRST PRSIN ;COMPLAIN
PUSHJ P,IINS ;RELEASE CH
RELEAS
PUSH P,.SBNAM(P1) ;-3(P) SAVE ORG STUFF
PUSH P,.SMNAM(P1) ;-2(P)
SETZM .SMNAM(P1) ;PASS NON-WILD MASK TO USER
PUSH P,.SBEXT(P1) ;-1(P)
MOVE T1,OPN+.OPBUF ;GET ADR OF BUF
HRRZ T1,1(T1)
TLOA T1,-<DTNUM+1> ;AOB POINTER
DTALOP: POP P,T1 ;RECALL COUNTS
AOBJP T1,DTADON ;BUMP COUNTS
PUSH P,T1 ;STORE COUNTS AGAIN
SKIPN T2,DTNAM-1(T1) ;GET FILENAME FROM DIR
JRST DTALOP
MOVEM T2,.SBNAM(P1) ;PASS IT TO USER
XOR T2,-3(P) ;MATCH WILD MASK?
ANDCM T2,-2(P)
JUMPN T2,DTALOP ;NO, TRY NEXT FILE
MOVE T2,DTEXT-1(T1) ;GET EXTENSION FROM DIR
HLLZM T2,.SBEXT(P1) ;PASS IT TO USER
XOR T2,-1(P) ;MATCH WILD MASK?
HRLO T3,-1(P)
ANDCM T2,T3
JUMPN T2,DTALOP ;NO, TRY NEXT FILE
PUSHJ P,(P2) ;YES, DO USER ROUTINE
JFCL
JRST DTALOP ;TRY FOR ANOTHER FILE
;HERE WHEN ALL 22 DTA FILES ARE DONE
DTADON: POP P,.SBEXT(P1) ;RESTORE ORG STUFF
POP P,.SMNAM(P1)
POP P,.SBNAM(P1)
PUSHJ P,ICLS ;CLOSE THE CH
JRST CPOPJ1
;ROUTINE TO DO DISK WILDCARDS
;P1 PASSES ADR FILE SPEC
;P2 PASSES ADR USER ROUTINE
;POSSIBLE SKIP RETURN (MEANINGLESS)
WLD: PUSHJ P,WILDP ;WILD?
JRST (P2) ;NO, JUST GOTO USER ROUTINE
PUSH P,P3 ;0(P3) BUILD ARG BLK TO WLDU IN STACK
MOVE P3,P ;SAVE IT'S ADR
PUSH P,P2 ;1(P3)
MOVEI P2,WLDU
PUSH P,.SBNAM(P1) ;2(P3)
PUSH P,.SMNAM(P1) ;3(P3)
PUSH P,.SBEXT(P1) ;4(P3)
PUSHJ P,PSHSPC ;GET PARENT DIR
PUSHJ P,WLD ;CALL WLDU FOR EACH FILE IN DIR
JFCL
PUSHJ P,POPSPC ;GET OFFSPRING PATH
POP P,.SBEXT(P1) ;RESTORE ORG STUFF
POP P,.SMNAM(P1)
POP P,.SBNAM(P1)
POP P,P2
POP P,P3
POPJ P,
;WLD IS SUPPOSED TO CALL A USER ROUTINE
;SOMETIMES IT CALLS ITSELF RECURSIVELY INSTEAD
;IF SO, IT REPLACES THE USER CALL WITH A CALL TO WLDU
;WLDU'S FUNCTION IS TO CALL THE ORG USER ROUTINE,
;ONCE FOR EACH FILE IN THE DIR
;CALL:
; MOVEI P1,<SPEC OF DIR>
; MOVEI P2,WLDU
; MOVEI P3,FOO
; PUSHJ P,(P2)
; JFCL
;FOO: WHEN CALLED RECURSIVELY, ADR OF CALLER'S ARG BLOCK
;FOO+1: ADR USER ROUTINE CALLER WAS SUPPOSED TO CALL
;FOO+2: NAME OF FILE TO FIND IN DIR
;FOO+3: WILD MASK FOR ABOVE FILENAME
;FOO+4: EXTENSION AND MASK
WLDU: PUSHJ P,FNDCH ;FIND A FREE CH
HALT
MOVEM T1,ICH ;ISELECT IT
PUSHJ P,LU ;LOOKUP THE DIR
JRST WLDLKP
PUSHJ P,POPSPC ;GET OFFSPRING PATH
MOVE P2,1(P3) ;RESTORE ADR ORG USER ROUTINE
PUSH P,P3 ;SAVE ADR ARG BLK
HRRZ T1,4(P3) ;WILD?
IOR T1,3(P3)
MOVE P3,(P3) ;RESTORE ADR CALLER'S ARG BLK
JUMPE T1,WLDESY ;NO, EASY
SETZM .SMNAM(P1) ;PASS NON-WILD MASK TO USER
WLDLOP: PUSHJ P,GETC ;INPUT THE FILE NAME
JRST WLDEOF ;EOF OR ERROR
MOVEM C,.SBNAM(P1) ;PASS IT TO USER
PUSHJ P,GETC ;INPUT THE EXTENSION
HALT
HLLZM C,.SBEXT(P1) ;PASS IT TO USER
SKIPN T1,.SBNAM(P1) ;NULL FILE?
JRST WLDLOP ;YES, IGNORE IT
MOVE T2,(P) ;FILENAME MATCH MASK?
XOR T1,2(T2)
ANDCM T1,3(T2)
JUMPN T1,WLDLOP ;NO, TRY NEXT FILE
XOR C,4(T2) ;EXTENSION MATCH MASK?
HRLO T1,4(T2)
ANDCM C,T1
JUMPN C,WLDLOP ;NO, TRY NEXT FILE
PUSH P,ICH ;SAVE DIR CH
PUSHJ P,(P2) ;CALL USER ROUTINE
JFCL
POP P,ICH ;RESTORE DIR CH
JRST WLDLOP ;TRY FOR ANOTHER FILE
;HERE WHEN SPEC ISN'T WILD AFTER ALL
WLDESY: MOVE T2,(P) ;GET ADR ARG BLK
MOVE T1,2(T2) ;PUT IN NAME OF FILE
MOVEM T1,.SBNAM(P1)
MOVE T1,4(T2)
MOVEM T1,.SBEXT(P1)
PUSH P,ICH ;SAVE CH
PUSHJ P,(P2) ;CALL USER ROUTINE
JFCL
POP P,ICH ;RESTORE CH
WLDEOF: PUSHJ P,PSHSPC ;GET PARENT DIR BACK
POP P,P3 ;RESTORE ADR ARG BLK
MOVEI P2,WLDU ;RESTORE P2
WLDLKP: JRST ICLS ;RELEASE THE CH
;ROUTINE TO FIND PARENT SFD OR UFD
;P1 PASSES ADR OF FILE SPEC
;THE SPEC IS NOT PRESERVED!
;IT IS CONVERTED INTO PARENT SPEC
PSHSPC: SKIPN .SBPPN(P1) ;PATH SPECIFIED?
PUSHJ P,MYPATH ;NO, USE DEFAULT
IFE SFDS,<
MOVE T2,.SBPPN(P1) ;MOVE UFD TO FRONT
MOVEM T2,.SBNAM(P1)
MOVE T2,.SMPPN(P1)
MOVEM T2,.SMNAM(P1)
> ;END IFE SFDS
IFN SFDS,<
MOVE T1,P1 ;FIND END OF PATH
PSHSP1: SKIPE .SBPPN+1(T1)
AOJA T1,PSHSP1
MOVE T2,.SBPPN(T1) ;MOVE LAST SFD TO FRONT
MOVEM T2,.SBNAM(P1)
MOVE T2,.SMPPN(T1)
MOVEM T2,.SMNAM(P1)
HRLZI T2,'SFD'
MOVEM T2,.SBEXT(P1)
SETZM .SBPPN(T1) ;CHOP IT OFF THE END
CAME T1,P1 ;IT WAS AN SFD WASN'T IT?
POPJ P, ;YES, LUCKY GUESS
> ;END IFN SFDS
HRLZI T2,'UFD' ;NO, OOPS A UFD
MOVEM T2,.SBEXT(P1)
MOVE T2,[%LDMFD] ;A UFD'S PARENT IS THE MFD
GETTAB T2, ;GET THE MFD PPN
MOVE T2,[XWD 1,1]
MOVEM T2,.SBPPN(P1)
SETZM .SMPPN(P1) ;THERE'S ONLY ONE MFD!
POPJ P,
;THIS ROUTINE IS THE CONVERSE OF PSHSPC
;IE IT CONVERTS THE SPEC OF A DIR INTO THE PATH OF AN OFFSPRING FILE
POPSPC: IFN SFDS,<
MOVE T1,P1 ;ASSUME UFD
HLRZ T2,.SBEXT(P1) ;A UFD?
CAIN T2,'UFD'
JRST POPSP1 ;YES, ALREADY KNOW LENGTH OF PATH
POPSP2: SKIPE .SBPPN(T1) ;NO, FIND END OF PATH
AOJA T1,POPSP2
POPSP1: MOVE T2,.SBNAM(P1) ;MOVE FILE THERE
MOVEM T2,.SBPPN(T1)
MOVE T2,.SMNAM(P1)
MOVEM T2,.SMPPN(T1)
SETZM .SBPPN+1(T1) ;ADD TERMINATOR
> ;END IFN SFDS
IFE SFDS,<
MOVE T2,.SBNAM(P1) ;MOVE FILE TO PATH
MOVEM T2,.SBPPN(P1)
MOVE T2,.SMNAM(P1)
MOVEM T2,.SMPPN(P1)
> ;END IFE SFDS
POPJ P,
LU: PUSH P,.SBMOD(P1) ;SAVE ORG MODE
MOVEI T1,.IOIBN ;SET MODE TO IMAGE
MOVEM T1,.SBMOD(P1)
PUSHJ P,SLKP ;TRY TO LOOKUP
JRST LU0
POP P,.SBMOD(P1) ;RESTORE ORG MODE
JRST CPOPJ1
LU0: POP P,.SBMOD(P1) ;RESTORE ORG MODE
HRRZ T1,FIL+1 ;GET ERROR CODE
JUMPE T1,CPOPJ ;ERFNF% FILE NOT FOUND
IFN SFDS,<
CAIE T1,ERSNF% ;SFD NOT FOUND
> ;END IFN SFDS
CAIN T1,ERIPP% ;UFD NOT FOUND
POPJ P,
JRST PRSLKP
PRGEND
TITLE WLDNSF
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY WLDNSF
INTERN WLDCNT
EXTERN SPCO,VERBO
WLDNSF: MOVEI T1,WLD1
PJRST VERBO
SPCO
WLD1: VB 0,"%",WLDNSF,<No such files as ^>
LIT ;PUT LITERALS IN HISEG
RELOC 0 ;SWITCH TO LOWSEG
WLDCNT: BLOCK 1 ;COUNT OF FILES
PRGEND
TITLE WILDP - TEST IF SPEC IS WILD
;P1 PASSES ADR SPEC
;SKIP IF WILD
;THIS ROUTINE ONLY CONSIDERS THE MASK WORDS
;IT DOESN'T CHECK SEARCH LISTS
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY WILDP
EXTERN CPOPJ1
WILDP: HRRZ T1,.SMEXT(P1) ;EXTENSION
IOR T1,.SMDEV(P1) ;DEVICE
IOR T1,.SMNAM(P1) ;FILENAME
IFN SFDS,<
SKIPA T2,P1 ;SETUP LOOP
WILDP1: IOR T1,.SMPPN-1(T2) ;SFD
SKIPE .SBPPN(T2) ;LAST SFD?
AOJA T2,WILDP1 ;NO, TRY NEXT
> ;END IFN SFDS
IFE SFDS,<
IOR T1,.SMPPN(P1) ;UFD
> ;END IFE SFDS
JUMPN T1,CPOPJ1
POPJ P,
PRGEND
TITLE FNDCH - FIND A FREE CH
;T1 RETURN CH
;SKIP IF WIN
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY FNDCH
EXTERN CPOPJ1
FNDCH: MOVEI T1,17 ;COUNT CH'S
FNDCH1: MOVE T2,T1 ;GET DEVICE TYPE
DEVTYP T2,
HALT
JUMPE T2,CPOPJ1 ;0 MEANS NOT OPEN
SOJGE T1,FNDCH1 ;ELSE TRY NEXT CH
HALT
PRGEND
TITLE IREN - RENAME INPUT
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY IREN
EXTERN CNVSPC,IINS,FIL,PRSLKP,ICLS,CPOPJ1
IREN: PUSHJ P,CNVSPC ;CONVERT TO TRAD FORMAT
PUSHJ P,IINS ;RENAME IT
RENAME FIL
JRST PRSLKP
PUSHJ P,ICLS ;CLOSE CH
JRST CPOPJ1
PRGEND
TITLE OREN - RENAME OUTPUT
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OREN
EXTERN CNVSPC,OINS,FIL,PRSLKP,OCL,PUTBUF,CPOPJ1
OREN: PUSHJ P,PUTBUF ;OUTPUT LAST BUF
POPJ P,
PUSHJ P,CNVSPC ;CONVERT TO TRAD FORMAT
PUSHJ P,OINS ;RENAME IT
RENAME FIL
JRST PRSLKP
PUSHJ P,OCL ;CLOSE CH
JRST CPOPJ1
PRGEND
TITLE LKP - LOOKUP A FILE
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY LKP
EXTERN SLKP,PRSLKP,CPOPJ1
LKP: PUSHJ P,SLKP ;DO THE LOOKUP
JRST PRSLKP
JRST CPOPJ1
PRGEND
TITLE SLKP - LOOKUP A FILE
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY SLKP
EXTERN OPN,ICLS,GETBLK
EXTERN ICH,RNGHDR,GETRNG,CNVSPC,IINS,FIL,CPOPJ1
SLKP: PUSHJ P,ICLS ;IN CASE ALREADY OPEN
PUSHJ P,CNVSPC ;CONVERT TO TRAD FORMAT
MOVEI T1,3 ;GET A RING HDR
PUSHJ P,GETBLK
POPJ P,
MOVEM T2,OPN+.OPBUF ;STORE ADR
MOVE T3,ICH
HRRM T2,RNGHDR(T3)
PUSHJ P,IINS ;OPEN DEV
OPEN OPN
JRST SLKP0
HRRZ T2,OPN+.OPBUF ;GET BUF RING
PUSHJ P,GETRNG
POPJ P,
PUSHJ P,IINS ;LOOKUP FILE
LOOKUP FIL
POPJ P,
JRST CPOPJ1
SLKP0: MOVEI T1,ERNSD% ;OPEN FAILED
HRRM T1,FIL+1
POPJ P,
PRGEND
TITLE NTR - ENTER A FILE
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY NTR
EXTERN OCH,RNGHDR,GETRNG,CNVSPC,OINS,FIL,PRSOPN,PRSLKP,CPOPJ1
EXTERN OPN,OCL,GETBLK
NTR: PUSHJ P,OCL ;IN CASE ALREADY OPEN
PUSHJ P,CNVSPC ;CONVERT TO TRAD FORMAT
MOVEI T1,3 ;GET A RING HDR
PUSHJ P,GETBLK
POPJ P,
HRLZM T2,OPN+.OPBUF ;STORE ADR
MOVE T3,OCH
HRLM T2,RNGHDR(T3)
PUSHJ P,OINS ;OPEN DEV
OPEN OPN
JRST PRSOPN
HLRZ T2,OPN+.OPBUF ;GET BUF RING
PUSHJ P,GETRNG
POPJ P,
PUSHJ P,OINS ;ENTER FILE
ENTER FIL
JRST PRSLKP
JRST CPOPJ1
PRGEND
TITLE PRSOPN
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY PRSOPN
EXTERN FIL,PRSLKP
PRSOPN: MOVEI T1,ERNSD% ;NO SUCH DEVICE
HRRM T1,FIL+1
JRST PRSLKP
PRGEND
TITLE PRSLKP
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSLKP
EXTERN OCTO,SPCO,FIL,VERBO
PRSLKP: MOVEI T1,ERRM
PJRST VERBO
SPCO
ERRM1
ERRM: VB ER.EAT,"?",PRSLKP,<LOOKUP ENTER error ^ for ^>
ERRM1: HRRZ T1,FIL+1
PJRST OCTO
PRGEND
TITLE ICLS - CLOSE INPUT CH
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY ICLS
EXTERN IINS,ICH,RNGHDR,DELRNG
ICLS: PUSHJ P,IINS ;RELEASE IT
RELEAS
MOVE T2,ICH ;GET ADR RING HDR
HRRZ T1,RNGHDR(T2)
HLLZS RNGHDR(T2) ;CLEAR SAME
JRST DELRNG ;RECLAIM CORE
PRGEND
TITLE OCLS - CLOSE OUTPUT CH
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OCLS
EXTERN PUTBUF,OCL,CPOPJ1
OCLS: PUSHJ P,PUTBUF ;OUTPUT LAST BUF
POPJ P,
PUSHJ P,OCL
JRST CPOPJ1
PRGEND
TITLE OCL
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OCL
EXTERN RNGHDR,OINS,OCH,DELRNG
OCL: PUSHJ P,OINS ;RELEASE IT
RELEAS
MOVE T2,OCH ;GET ADR RING HDR
HLRZ T1,RNGHDR(T2)
HRRZS RNGHDR(T2) ;CLEAR SAME
;FALL TO DELRNG
PRGEND
TITLE DELRNG
;T1 PASSES ADR RING HDR
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY DELRNG
EXTERN CPOPJ,FREMEM
DELRNG: JUMPE T1,CPOPJ ;QUIT IF NO HDR
MOVEI T2,3 ;LENGHT HDR
HRRZ T3,(T1) ;ADR 1ST BUF
RNGLOP: SETZM 1(T1) ;FLAG THAT WE'VE BEEN HERE
HRLZM T2,(T1) ;STORE LENGHT
HRRZ T2,FREMEM ;DELETE BLK
HRRM T2,(T1)
HRRM T1,FREMEM
MOVEI T1,-1(T3) ;TOP OF BLK
HLRZ T2,1(T1) ;LENGHT
ADDI T2,2
HRRZ T3,1(T1) ;ADR NEXT BUF
JUMPN T3,RNGLOP ;LOOP UNLESS BEEN HERE BEFORE
POPJ P,
PRGEND
TITLE PUR - PURGE CORE
;RECLAIMS CORE FROM A LINKAGE LIST
;T1 PASSES ADR OF ADR OF LIST
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PUR
EXTERN CPOPJ,FREMEM
PUR: HRRZ T2,(T1) ;ADR NEXT BLK
JUMPE T2,CPOPJ ;QUIT IF NONE
HRRZ T3,(T2) ;UNLINK IT
HRRM T3,(T1)
HRRZ T3,FREMEM ;LINK TO FREE LIST
HRRM T3,(T2)
HRRM T2,FREMEM ;NEW 1ST FREE
JRST PUR ;TRY ANOTHER
PRGEND
TITLE GETRNG - GET BUF RING
;T2 PASSES ADR RING HDR
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY GETRNG
EXTERN SAVE2,GETBLK,CPOPJ1,OPN
GETRNG: PUSHJ P,SAVE2 ;SAVE P1-P2
MOVE P2,T2 ;P2=ADR RING HDR
MOVEI T1,OPN ;GET DEVICE SIZE
DEVSIZ T1,
HALT
HLRZ P1,T1 ;P1=# BUFS
TLZ T1,-1 ;T1=SIZE BUF
RNGLOP: PUSHJ P,GETBLK ;GET A CORE BLK
POPJ P,
AOS T3,T2 ;USE ADR+1
HRLI T3,(1B0) ;SET USE BIT
SKIPN (P2) ;1ST BUF?
MOVEM T3,(P2) ;YES, STORE ADR IN HDR
MOVE T3,@(P2) ;GET LINK FROM 1ST BUF
MOVEM T3,(T2) ;MOVE TO NEW BUF
HRLI T2,-2(T1) ;BUILD LINK TO NEW BUF
MOVEM T2,@(P2) ;STORE IN 1ST BUF
SOJG P1,RNGLOP ;LOOP FOR EACH BUF
JRST CPOPJ1
PRGEND
TITLE GETBLK - GET A CORE BLOCK
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY GETBLK
EXTERN .JBFF,.JBREL,PRSCOR,SAVE3,CPOPJ1,CPOPJ,FREMEM
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADR OF BLK
GETBLK: PUSHJ P,TRYBLK ;ANY FREE BLOCKS?
JRST GOT ;YES
MOVE T2,.JBFF ;NO, ENOUGH CORE TO MAKE 1?
ADD T2,T1
CAMG T2,.JBREL
JRST GETESY ;YES
PUSHJ P,GC ;NO, GARBAGE COLLECT
PUSHJ P,TRYBLK ;TRY AGAIN
JRST GOT ;WIN
MOVE T2,.JBFF ;STILL LOSE, GET MORE CORE
ADD T2,T1
MOVE T3,T2
CORE T3,
JRST PRSCOR
GETESY: EXCH T2,.JBFF ;T2=ADR OF BLK
GOT: HRLZM T1,(T2) ;BLK KNOWS ITS OWN SIZE
JRST CPOPJ1
;ROUTINE TO TRY TO FIND A FREE CORE BLK
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADR OF BLK
;SKIP IF FAIL
TRYBLK: PUSHJ P,SAVE3 ;SAVE P1-P3
SETO P1, ;FLAG NONE SO FAR
MOVEI P2,FREMEM ;POINT TO 0TH FREE BLK
TRYLOP: MOVE P3,P2 ;ADVANCE TO NEXT BLK
HRRZ P2,(P3)
JUMPE P2,TRY1 ;QUIT IF NO MORE BLKS
HLRZ T4,(P2) ;GET SIZE OF BLK
CAML T4,T1 ;BIG ENOUGH?
CAIL T4,(P1) ;AND SMALLEST SO FAR?
JRST TRYLOP ;NO
MOVE P1,T4 ;YES, REMEMBER WHERE IT IS
MOVE T3,P3
CAME P1,T1 ;BEST PERFECT?
JRST TRYLOP ;NO, CHECK THE REST
TRY1: JUMPL P1,CPOPJ1 ;QUIT IF NO WINNERS AT ALL
HRRZ T2,(T3) ;ADR OF BEST
CAMG P1,T1 ;TOO BIG?
JRST TRYESY ;NO, JUST RIGHT
MOVE P2,T2 ;COMPUTE ADR OF LEFTOVER
ADD P2,T1
SUB P1,T1 ;COMPUTE SIZE OF LEFTOVER
HRL P1,(T2) ;SPLIT INTO TWO BLKS
MOVSM P1,(P2)
HRL P2,T1
MOVEM P2,(T2)
TRYESY: HRRZ T4,(T2) ;UNLINK THE BLK
HRRM T4,(T3)
POPJ P,
;GARBAGE COLLECT ROUTINE
;COMBINES CONSECUTIVE FRAGMENTS
;T1 IS PRESERVED
GC: PUSHJ P,SAVE3 ;SAVE P1-P3
MOVEI P3,FREMEM ;POINT TO 0TH FREE BLK
GCLOP1: HRRZ P3,(P3) ;ADVANCE TO NEXT BLK
JUMPE P3,CPOPJ ;QUIT IF NO MORE BLKS
HLRZ T3,(P3) ;COMPUTE ADR JUST PAST END
GCAGN: ADD T3,P3
MOVEI P2,FREMEM ;SEARCH FOR A FREE BLK THERE
GCLOP2: MOVE P1,P2
HRRZ P2,(P1)
JUMPE P2,GCLOP1
CAME P2,T3
JRST GCLOP2
HRRZ T3,(P2) ;UNLINK IT
HRRM T3,(P1)
HLRZ T3,(P3) ;COMPUTE SIZE COMBINED BLK
HLRZ T2,(P2)
ADD T3,T2
HRLM T3,(P3) ;COMBINE THEM
JRST GCAGN
PRGEND
TITLE PRSCOR
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSCOR
PRSCOR: ERR 0,"%",PRSCOR,<Not enough core>
PRGEND
TITLE SPCO - OUTPUT FILE SPEC
;P1 PASSES ADR SPEC
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY SPCO
EXTERN SIXO,CO,CPOPJ1,FOO,SAVE1,SAVE2
SPCO: MOVE T2,.SBDEV(P1) ;DEVICE NAME
SKIPE T4,.SMDEV(P1) ;WILD DEVICE?
JRST SPCO5 ;YES, NOT DSK
CAMN T2,[SIXBIT /DSK/] ;DEVICE DSK?
JRST SPCO1 ;YES, DON'T SAY IT
SPCO5: PUSHJ P,WSIXO ;SAY DEVICE
POPJ P,
MOVEI C,":"
PUSHJ P,CO
POPJ P,
SPCO1: HLRZ T1,.SBEXT(P1) ;UFD?
CAIE T1,'UFD'
JRST NOTUFD ;NO
MOVE T1,.SBNAM(P1) ;YES, OUTPUT FILENAME AS PPN
MOVE T2,.SMNAM(P1)
PUSHJ P,WPPNO
POPJ P,
MOVEI C,"]" ;RIGHT BRACKET
PUSHJ P,CO
POPJ P,
JRST UFD
NOTUFD: MOVE T2,.SBNAM(P1) ;FILENAME
MOVE T4,.SMNAM(P1)
PUSHJ P,WSIXO
POPJ P,
UFD: MOVEI C,"." ;DOT
PUSHJ P,CO
POPJ P,
HLLZ T2,.SBEXT(P1) ;EXTENSION
HRRZ T4,.SMEXT(P1)
CAIN T4,-1
SETO T4,
MOVSS T4
PUSHJ P,WSIXO
POPJ P,
SKIPE .SMDEV(P1) ;WILD DEVICE MEANS DISK
JRST SPCO2
MOVE T1,.SBDEV(P1) ;A DISK?
DEVCHR T1,
TLNN T1,(DV.DSK)
JRST CPOPJ1 ;NO, ONLY DISKS HAVE PATHS
SPCO2: SKIPN .SBPPN(P1) ;PATH SPECIFIED?
JRST CPOPJ1 ;NO
SETOM FOO ;GET DEFAULT PATH
MOVE T1,[XWD SFDS+4,FOO]
PATH. T1,
HALT
IFE SFDS,<
SKIPE .SMPPN(P1) ;ALWAYS PRINT WILDCARDS
JRST SPCO3
MOVE T1,FOO+.PTPPN ;MATCHES DEFAULT PATH?
CAMN T1,.SBPPN(P1)
JRST CPOPJ1 ;YES, DON'T SAY IT
>
IFN SFDS,<
MOVE T1,P1 ;POINTERS TO PATH
MOVEI T2,FOO+.PTPPN
SPCO4: SKIPE T3,.SBPPN(T1) ;GET WORD FROM PATH
SKIPN .SMPPN(T1) ;ALWAYS PRINT WILDCARDS
CAME T3,(T2) ;PRINT IF NOT DEFAULT
JRST SPCO3
JUMPE T3,CPOPJ1 ;QUIT IF LAST SFD
ADDI T2,1 ;LOOP UNTIL 0 SFD
AOJA T1,SPCO4
>
SPCO3: MOVE T1,.SBPPN(P1) ;OUTPUT PPN
MOVE T2,.SMPPN(P1)
PUSHJ P,WPPNO
POPJ P,
IFN SFDS,<
PUSHJ P,SAVE1 ;SAVE P1
SPCLOP: SKIPN .SBPPN+1(P1) ;ANOTHER SFD?
JRST SPCDON ;NO
MOVEI C,"," ;YES, COMMA
PUSHJ P,CO
POPJ P,
MOVE T2,.SBPPN+1(P1) ;SFD
MOVE T4,.SMPPN+1(P1)
PUSHJ P,WSIXO
POPJ P,
AOJA P1,SPCLOP ;LOOP UNTIL 0 SFD
> ;END IFN FTSFDS
SPCDON: MOVEI C,"]" ;END PATH
JRST CO
;ROUTINE TO OUTPUT A PPN WITH WILDCARDS
;T1 PASSES PPN
;T2 PASSES MASK
WPPNO: PUSHJ P,SAVE2 ;SAVE P1-P2
MOVE P1,T1 ;SAVE PPN
MOVE P2,T2 ;SAVE MASK
MOVEI C,"[" ;LEFT BRACKET
PUSHJ P,CO
POPJ P,
HLRZ T1,P1 ;PROJECT
HLRZ T3,P2 ;PROJECT MASK
PUSHJ P,WOCTO ;OUTPUT IT
POPJ P,
MOVEI C,"," ;COMMA
PUSHJ P,CO
POPJ P,
HRRZ T1,P1 ;PROGRAMMER
HRRZ T3,P2 ;PROGRAMMER MASK
;FALL TO WOCTO
;ROUTINE TO OUTPUT OCTAL NUMBER WITH WILDCARDS
;T1 PASSES NUMBER
;T3 PASSES MASK
WOCTO: SETZB T2,T4
WOCTO1: LSHC T1,-3 ;GET LOW ORDER NIBBLE
LSH T2,-3 ;CONVERT TO SIXBIT
TLO T2,'0 '
LSHC T3,-3 ;GET LOW ORDER NIBBLE OF MASK
ASH T4,-3 ;REPLICATE HIGH BIT
JUMPN T1,WOCTO1 ;LOOP UNTIL WORD GONE
JUMPN T3,WOCTO1 ;AND MASK GONE
;FALL TO WSIXO
;ROUTINE TO OUTPUT SIXBIT NAME WITH WILDCARDS
;T2 PASSES NAME
;T4 PASSES MASK
WSIXO: ANDCM T2,T4 ;REMOVE WILD FIELDS
MOVE T1,[SIXBIT /??????/] ;EXTRACT WILD FIELDS
AND T1,T4
ADD T1,T2 ;COMBINE THEM
CAMN T1,[SIXBIT /??????/] ;STAR?
HRLZI T1,'* ' ;YES, SAY SO
JRST SIXO ;OUTPUT IT
PRGEND
TITLE PROMPT - PROMPT USER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PROMPT
EXTERN ICH,CI,SWTCH,EATCR,BP,CPOPJ1,CRLF
PROMPT: SKPINC ;STOP CTRL-O
JFCL
SETOM ICH ;ISELECT TTY
OUTSTR CRLF
LOOP: OUTCHR ["*"] ;PROMPT HIM
PUSHJ P,CI ;INPUT 1ST CHAR
POPJ P,
PUSHJ P,SWTCH ;PARSE SWITCHES
POPJ P,
PUSHJ P,EATCR ;EAT <CR>
POPJ P,
PUSHJ P,BP ;BREAK CHAR?
JRST CPOPJ1 ;NO
CAIN C,"Z"-100 ;YES, CONTROL Z?
EXIT 1, ;YES
JRST LOOP
PRGEND
TITLE PRMPT - PROMPT USER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRMPT
EXTERN ICH,CI,EATCR,BP,CPOPJ1,CRLF
PRMPT: SKPINC ;STOP CTRL-O
JFCL
SETOM ICH ;ISELECT TTY
OUTSTR CRLF
LOOP: OUTCHR ["*"] ;PROMPT HIM
PUSHJ P,CI ;INPUT 1ST CHAR
POPJ P,
PUSHJ P,EATCR ;EAT <CR>
POPJ P,
PUSHJ P,BP ;BREAK CHAR?
JRST CPOPJ1 ;NO
CAIN C,"Z"-100 ;YES, CONTROL Z?
EXIT 1, ;YES
JRST LOOP
PRGEND
TITLE CRLFO - OUTPUT CARRIAGE RETURN LINE FEED
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CRLFO
EXTERN STRO,CRLF
CRLFO: MOVEI T1,CRLF
;FALL TO STRO
PRGEND
TITLE STRO - OUTPUT AN ASCIZ STRING
;T1 PASSES ADR OF STRING
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY STRO
EXTERN BPO
STRO: HRLI T1,(POINT 7,0) ;MAKE INTO BP
;FALL TO BPO
PRGEND
TITLE BPO - OUTPUT AN ASCIZ STRING
;T1 PASSES BP TO STRING
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY BPO
EXTERN CPOPJ1,CO,SAVE1
BPO: PUSHJ P,SAVE1 ;SAVE P1
MOVE P1,T1 ;COPY ARG
PTBPLP: ILDB C,P1 ;GET A CHAR
JUMPE C,CPOPJ1 ;QUIT ON 0
PUSHJ P,CO ;OUTPUT IT
POPJ P,
JRST PTBPLP
PRGEND
TITLE DECO - OUTPUT A DECIMAL NUMBER
;T1 PASSES THE NUMBER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY DECO
EXTERN NUMO
DECO: MOVEI T3,^D10 ;RADIX 10
JRST NUMO
PRGEND
TITLE OCTO - OUTPUT AN OCTAL NUMBER
;T1 PASSES THE NUMBER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OCTO
EXTERN NUMO
OCTO: MOVEI T3,10 ;RADIX 8
JRST NUMO
PRGEND
TITLE NUMO - OUTPUT A NUMBER
;T1 PASSES THE NUMBER
;T3 PASSES THE RADIX
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY NUMO
EXTERN CO
NUMO: IDIV T1,T3 ;DIVIDE BY RADIX
HRLM T2,(P) ;STORE REMAINDER
JUMPE T1,NUMO1 ;LOOP UNTIL NONE LEFT
PUSHJ P,NUMO
POPJ P,
NUMO1: HLRZ C,(P) ;RECALL REMAINDER LIFO
ADDI C,"0" ;CONVERT TO ASCII DIGIT
JRST CO ;OUTPUT IT
PRGEND
TITLE SIXO - OUTPUT SIXBIT WORD
;T1 PASSES THE WORD
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SIXO
EXTERN CO,CPOPJ1,SAVE2
SIXO: PUSHJ P,SAVE2 ;SAVE P1-P2
MOVE P2,T1 ;COPY ARG
SIXOLP: JUMPE P2,CPOPJ1 ;QUIT IF NONE LEFT
LSHC P1,6 ;EXTRACT HIGH CHAR
ANDI P1,77
MOVEI C,40(P1) ;CONVERT TO ASCII
PUSHJ P,CO ;OUTPUT IT
POPJ P,
JRST SIXOLP ;LOOP UNTIL NONE LEFT
PRGEND
TITLE CO - OUTPUT CHAR
;C PASSES THE CHAR
;OCH SELECTS WHERE OUTPUT GOES:
;TTY OCH=-1
;CORE OCH=POINT X,Y,Z
;DISK OCH=XWD 0,CHANNEL
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CO
EXTERN OCH,PUTC,CPOPJ1,PUTC1
CO: MOVE T1,OCH ;GET OUTPUT CH
TLNN T1,-1 ;FILE?
JRST PUTC1 ;YES
TLNE T1,40 ;NO, BP?
JRST CO0 ;NO, MUST BE TTY
IDPB C,OCH ;YES
JRST CPOPJ1
CO0: OUTCHR C ;TTY
JRST CPOPJ1
PRGEND
TITLE PUTC - OUTPUT A CHAR
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PUTC
INTERN PUTC1
EXTERN OCH,RNGHDR,PUTBUF,CPOPJ1
PUTC2: PUSHJ P,PUTBUF ;OUTPUT THE BUF
POPJ P,
PUTC: MOVE T1,OCH ;GET OUTPUT CH
PUTC1: HLRZ T1,RNGHDR(T1) ;GET ADR RING HDR
SOSGE 2(T1) ;MORE ROOM IN BUF?
JRST PUTC2 ;NO, OUTPUT THE BUF
IDPB C,1(T1) ;YES, PUT CHAR IN
JRST CPOPJ1
PRGEND
TITLE PUTBUF - OUTPUT A BUFFER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PUTBUF
EXTERN OINS,CPOPJ1,PRSOUT
PUTBUF: PUSHJ P,OINS
OUT
JRST CPOPJ1
JRST PRSOUT
PRGEND
TITLE PRSOUT
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSOUT
EXTERN OCH,SIXO,SAVE1,VERBO,OCTO,OINS
PRSOUT: PUSHJ P,SAVE1
PUSHJ P,OINS
GETSTS P1
HRL P1,OCH
MOVEI T1,ERRM
PJRST VERBO
ERRM2: HRRZ T1,P1
PJRST OCTO
ERRM1
ERRM2
ERRM: VB ER.EAT,"?",PRSOUT,<Output error ^ for ^>
ERRM1: HLRZ T1,P1
DEVNAM T1,
HALT
PJRST SIXO
PRGEND
TITLE WLDMAT - MATCH WLD SPC'S
;P1 PASSES ADR LOOKUP SPC (OUTPUT FROM WILD)
;P2 PASSES ADR WILD SPC
;P3 PASSES ADR TO RETURN NEW SPC
;WLDMAT TAKES SPECIFICS FROM P1 ADDS THEM TO P2 AND PUTS
;RESULTS IN P3
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY WLDMAT
WLDMAT: HRLZ T1,P2 ;COPY SWITCHES
HRR T1,P3
HLRZ T2,(P2)
ADD T2,P3
BLT T1,-1(T2)
MOVE T1,.SBDEV(P2) ;DEVICE
ANDCM T1,.SMDEV(P2)
MOVE T2,.SBDEV(P1)
AND T2,.SMDEV(P2)
ADD T1,T2
MOVEM T1,.SBDEV(P3)
SETZM .SMDEV(P3)
MOVE T1,.SBNAM(P2) ;FILENAME
ANDCM T1,.SMNAM(P2)
MOVE T2,.SBNAM(P1)
AND T2,.SMNAM(P2)
ADD T1,T2
MOVEM T1,.SBNAM(P3)
SETZM .SMNAM(P3)
HLRZ T1,.SBEXT(P2) ;EXTENSION
HRRZ T2,.SMEXT(P2)
ANDCM T1,T2
HLRZ T3,.SBEXT(P1)
AND T3,T2
ADD T1,T3
HRLZM T1,.SBEXT(P3)
IFN SFDS,<
EXTERN SAVE3
PUSHJ P,SAVE3 ;SAVE P1-P3
> ;END IFN SFDS
WLDMT0: MOVE T1,.SBPPN(P2) ;DIRECTORY
ANDCM T1,.SMPPN(P2)
MOVE T2,.SBPPN(P1)
AND T2,.SMPPN(P2)
ADD T1,T2
MOVEM T1,.SBPPN(P3)
SETZM .SMPPN(P3)
IFN SFDS,<
ADDI P2,1 ;LOOP FOR EACH DIR
ADDI P3,1
SKIPE .SBPPN+1(P1)
AOJA P1,WLDMT0
> ;END IFN SFDS
POPJ P,
PRGEND
TITLE CNVSPC - CONVERT SPC BLK TO TRADITIONAL BLKS
;P1 PASSES ADR SPC BLK
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY CNVSPC
EXTERN FIL,OPN
CNVSPC: MOVE T4,.SBDEV(P1) ;DEVICE
MOVEM T4,OPN+.OPDEV
MOVE T4,.SBMOD(P1) ;MODE
MOVEM T4,OPN+.OPMOD
MOVE T4,.SBNAM(P1) ;FILENAME
MOVEM T4,FIL
HLLZ T4,.SBEXT(P1) ;EXTENSION
MOVEM T4,FIL+1
SETZM FIL+2
IFE SFDS,<
MOVE T4,.SBPPN(P1) ;PPN
MOVEM T4,FIL+3
> ;END IFE SFDS
IFN SFDS,<
EXTERN PTH
HRLZI T1,.SBPPN(P1) ;COPY PATH
HRRI T1,PTH+.PTPPN
BLT T1,PTH+.PTPPN+SFDS+1
SKIPE T3,.SBPPN(P1) ;POINT TO PATH
MOVEI T3,PTH
MOVEM T3,FIL+3
> ;END IFN SFDS
POPJ P,
PRGEND
TITLE SPCI - INPUT A FILE SPEC
;P1 PASSES ADR OF FILE SPEC
;SKIP IF SUCCESSFUL
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SPCI
EXTERN WSIXI,EATS,CI,CPOPJ1,PRSPTH,MYPATH,SAVE2
SPCI: PUSHJ P,WSIXI ;DEVICE OR FILE NAME?
POPJ P,
PUSHJ P,EATS ;WHICH?
POPJ P,
CAIE C,":"
JRST SPCI2 ;FILENAME
JUMPE T1,SPCI5 ;0 MEANS USE DEFAULT
MOVEM T1,.SBDEV(P1) ;DEVICE, SAVE IT
MOVEM T2,.SMDEV(P1)
SPCI5: PUSHJ P,CI ;EAT THE COLON
POPJ P,
PUSHJ P,WSIXI ;INPUT THE FILENAME
POPJ P,
SPCI2: JUMPE T1,SPCI6 ;0 MEANS USE DEFAULT
MOVEM T1,.SBNAM(P1) ;SAVE FILENAME
MOVEM T2,.SMNAM(P1)
SPCI6: PUSHJ P,EATS ;EXTENSION?
POPJ P,
CAIE C,"."
JRST SPCI3 ;NO
PUSHJ P,CI ;YES, EAT THE DOT
POPJ P,
PUSHJ P,WSIXI ;INPUT THE EXTENSION
POPJ P,
HLR T1,T2 ;APPEND MASK
MOVEM T1,.SBEXT(P1) ;NO, SAVE IT
PUSHJ P,EATS ;PATH SPECIFIED?
POPJ P,
SPCI3: CAIE C,"["
JRST CPOPJ1 ;NO
PUSHJ P,CI ;YES, EAT THE BRACKET
POPJ P,
PUSHJ P,MYPATH ;GET DEFAULT PATH
PUSHJ P,WOCTI ;INPUT THE PROJECT NUMBER
POPJ P,
JUMPE T1,SPCI7 ;0 MEANS USE DEFAULT
HRLM T1,.SBPPN(P1) ;SAVE IT
HRLM T2,.SMPPN(P1)
SPCI7: PUSHJ P,EATS ;EAT A COMMA
POPJ P,
CAIE C,","
JRST PRSPTH
PUSHJ P,CI
POPJ P,
PUSHJ P,WOCTI ;INPUT THE PROGRAMER NUMBER
POPJ P,
JUMPE T1,SPCI8 ;0 MEANS USE DEFAULT
HRRM T1,.SBPPN(P1) ;SAVE IT
HRRM T2,.SMPPN(P1)
SPCI8:
IFN SFDS,<
EXTERN SAVE1
PUSHJ P,SAVE1 ;SAVE P1
HRLI P1,-SFDS ;COUNT SFDS
SPCLOP: PUSHJ P,EATS ;ANOTHER SFD?
POPJ P,
CAIE C,","
JRST SPCI4 ;NO
PUSHJ P,CI ;YES, EAT THE COMMA
POPJ P,
PUSHJ P,WSIXI ;INPUT THE SFD NAME
POPJ P,
JUMPE T1,SPCI9 ;0 MEANS USE DEFAULT
MOVEM T1,.SBPPN+1(P1) ;SAVE IT
MOVEM T2,.SMPPN+1(P1)
SPCI9: AOBJN P1,SPCLOP ;LOOK FOR ANOTHER
JRST PRSPTH
SPCI4: SETZM .SBPPN+1(P1) ;TERMINATE PATH
> ;END IFN SFDS
PUSHJ P,EATS ;EAT A BRACKET
POPJ P,
CAIN C,"]"
JRST CI
JRST CPOPJ1
;INPUT A PROJECT OR PROGRAMMER, WITH WILDCARDS
;T1 RETURNS THE NUMBER
;T2 RETURNS A WILDCARD MASK
WOCTI: PUSHJ P,SAVE2 ;SAVE P1-P2
SETZB P1,P2 ;DEFAULT TO ZERO
PUSHJ P,EATS ;EAT SPACES
POPJ P,
CAIE C,"*" ;THE UNIVERSE?
JRST WOCTI3 ;NO
PUSHJ P,CI ;YES, EAT IT
POPJ P,
SETOB T1,T2 ;RETURN THE WORLD
JRST CPOPJ1
WOCTI3: CAIL C,"0" ;VALID DIGIT OR WILDCARD?
CAILE C,"7"
CAIN C,"?"
JRST WOCTI1 ;YES
WOCTI2: MOVE T1,P1 ;NO, RETURN RESULTS
MOVE T2,P2
JRST CPOPJ1
WOCTI1: LSH P1,3 ;YES, APPEND TO NUMBER
LSH P2,3
TRZE C,10
ADDI P2,7
ADDI P1,-"0"(C)
PUSHJ P,CI ;INPUT NEXT CHAR
POPJ P,
JRST WOCTI3 ;TEST IF VALID
PRGEND
TITLE MYPATH - GET MY DEFAULT PATH
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY MYPATH
EXTERN FOO
MYPATH: SETOM FOO ;GET DEFAULT PATH
MOVE T1,[XWD SFDS+4,FOO]
PATH. T1,
HALT
IFE SFDS,<
MOVE T1,FOO+.PTPPN ;COPY IT TO SPC
MOVEM T1,.SBPPN(P1)
> ;END IFE SFDS
SETZM .SMPPN(P1) ;CLEAR WILDCARDS
IFN SFDS,<
HRRZI T1,.SBPPN(P1) ;COPY IT TO SPC
HRLI T1,FOO+.PTPPN
BLT T1,.SBPPN+SFDS+1(P1)
HRLZI T1,.SMPPN(P1)
HRRI T1,.SMPPN+1(P1)
BLT T1,.SMPPN+SFDS(P1)
> ;END IFN SFDS
POPJ P,
PRGEND
TITLE PRSPTH
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSPTH
PRSPTH: ERR ER.EAT,"?",PRSPTH,<Illegal format for path>
PRGEND
TITLE DECI - INPUT A DECIMAL NUMBER
;T1 RETURNS THE NUMBER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY DECI
EXTERN NUMI
DECI: MOVEI T3,^D10 ;RADIX 10
JRST NUMI
PRGEND
TITLE OCTI - INPUT AN OCTAL NUMBER
;T1 RETURNS THE NUMBER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OCTI
EXTERN NUMI
OCTI: MOVEI T3,10 ;RADIX 8
JRST NUMI
PRGEND
TITLE NUMI - INPUT A NUMBER
;T3 PASSES THE RADIX
;T1 RETURNS THE NUMBER
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY NUMI
EXTERN SAVE2,CI,CPOPJ1,EATS
NUMI: PUSHJ P,SAVE2 ;SAVE P1-P2
SETZ P1, ;DEFAULT TO ZERO
MOVE P2,T3 ;COPY RADIX
PUSHJ P,EATS ;EAT SPACES
POPJ P,
NUMILP: CAIL C,"0" ;LEGAL DIGIT?
CAILE C,"0"-1(P2)
JRST NUMI1 ;NO
IMUL P1,P2 ;YES, APPEND TO NUMBER
ADDI P1,-"0"(C)
PUSHJ P,CI ;INPUT NEXT CHAR
POPJ P,
JRST NUMILP
NUMI1: MOVE T1,P1 ;NO, RETURN NUMBER
JRST CPOPJ1
PRGEND
TITLE SIXI - INPUT A SIXBIT WORD
;T1 RETURNS THE WORD
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SIXI
EXTERN EATS,CI,CPOPJ1,SAVE2
SIXI: PUSHJ P,SAVE2 ;SAVE P1-P2
MOVEI P2,6*6 ;BIT COUNT
PUSHJ P,EATS ;EAT SPACES
POPJ P,
SIXLOP: SUBI C,40 ;CONVERT LOWER CASE TO UPPER
CAIL C,"A" ;UPPER CASE?
CAILE C,"Z"
ADDI C,40 ;NO, OOPS CONVERT BACK
CAIL C,"0" ;VALID SIXBIT CHAR?
CAILE C,"9"
CAIL C,"A"
CAILE C,"Z"
JRST SIXGOT ;NO
JUMPE P2,SIXNX ;ONLY 1ST 6 CHARS SIGNIFICANT
LSH P1,6 ;APPEND CHAR TO NAME
ADDI P1,-40(C)
SUBI P2,6 ;COUNT IT
SIXNX: PUSHJ P,CI ;INPUT NEXT CHAR
POPJ P,
JRST SIXLOP ;TEST IF VALID
SIXGOT: LSH P1,(P2) ;NO, LEFT JUSTIFY RESULTS
MOVE T1,P1
JRST CPOPJ1
PRGEND
TITLE WSIXI - INPUT A WILD SIXBIT WORD
;T1 RETURNS THE WORD
;T2 RETURNS A WILDCARD MASK
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY WSIXI
EXTERN EATS,CI,CPOPJ1,SAVE4
WSIXI: PUSHJ P,SAVE4 ;SAVE P1-P4
SETZB P2,P3 ;INITIAL MASK
MOVEI P4,6*6 ;BIT COUNT
PUSHJ P,EATS ;EAT SPACES
POPJ P,
WSIXI3: SUBI C,40 ;CONVERT LOWER CASE TO UPPER
CAIL C,"A" ;UPPER CASE?
CAILE C,"Z"
ADDI C,40 ;NO, OOPS CONVERT BACK
CAIE C,"*" ;VALID SIXBIT CHAR?
CAIL C,"0"
CAILE C,"9"
CAIL C,"A"
CAILE C,"Z"
CAIN C,"?"
JRST WSIXI1 ;YES
WSIXI4: LSH P1,(P4) ;NO, LEFT JUSTIFY RESULTS
LSHC P2,(P4)
MOVE T1,P1
MOVE T2,P2
JRST CPOPJ1
WSIXI1: JUMPE P4,WSIXI2 ;ONLY 1ST 6 CHARS SIGNIFICANT
LSH P1,6 ;APPEND CHAR TO NAME
ADDI P1,-40(C)
CAIN C,"?"
TLO P3,770000
CAIN C,"*"
SETO P3,
LSHC P2,6
SUBI P4,6 ;COUNT IT
WSIXI2: PUSHJ P,CI ;INPUT NEXT CHAR
POPJ P,
JUMPL P3,WSIXI4 ;QUIT IF "*"
JRST WSIXI3 ;ELSE LOOP
PRGEND
TITLE EATCR - EAT <CR>
;EATS LEADING SPACES AND TABS 1ST
;SKIP IF OK
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY EATCR
EXTERN EATS,CI,CPOPJ1
EATCR: PUSHJ P,EATS ;EAT SPACES
POPJ P,
CAIE C,15 ;EAT CR
JRST CPOPJ1
JRST CI
PRGEND
TITLE BP - TEST FOR BREAK CHAR
;SKIP IF YES
;ABE'S METHOD
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY BP
BP: MOVEI T1,1 ;BREAK CHAR?
LSH T1,(C)
TDNE T1,[1400016000]
AOS (P) ;YES, SKIP
POPJ P, ;NO
PRGEND
TITLE COLON - EAT COLON
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY COLON
EXTERN EATS,CI,PRSSYN
COLON: PUSHJ P,EATS ;EAT SPACES
POPJ P,
CAIE C,":" ;COLON?
JRST PRSSYN
JRST CI ;YES, EAT IT
PRGEND
TITLE EATS - EAT SPACES AND TABS
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY EATS
EXTERN CI,CPOPJ1
EATS1: PUSHJ P,CI ;INPUT NEXT CHAR
POPJ P,
EATS: CAIE C," " ;SPACE OR TAB?
CAIN C,11
JRST EATS1 ;YES, EAT IT
JRST CPOPJ1 ;NO
PRGEND
TITLE PRSSYN
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSSYN
PRSSYN: ERR ER.EAT,"?",PRSSYN,<Syntax error>
PRGEND
TITLE CI - INPUT A CHAR
;C RETURNS THE CHAR
;ICH SELECTS WHERE INPUT FROM:
;TTY ICH=-1
;CORE ICH=POINT X,Y,Z
;DISK ICH=XWD 0,CHANNEL
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CI
EXTERN ICH,LSNI,CPOPJ1
CI: MOVE C,ICH ;GET INPUT CH
TLNN C,-1 ;FILE?
JRST LSNI ;YES
TLNE C,40 ;NO, CORE?
JRST CI1 ;NO, MUST BE TTY
ILDB C,ICH ;YES
JRST CPOPJ1
CI1: INCHWL C ;TTY
JRST CPOPJ1
PRGEND
TITLE LSNI - INPUT A CHAR
;IGNORES LINE SEQUENCE NUMBERS
;SKIP IF OK
;ELSE NOSKIP
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY LSNI
EXTERN ICH,RNGHDR,GETC,CPOPJ1,SAVE2
LSNI: PUSHJ P,SAVE2 ;SAVE P1-P2
MOVE P1,ICH ;GET INPUT CH
HRRZ P1,RNGHDR(P1) ;GET ADR RING HDR
MOVEI P2,1 ;COUNT CHARS
LSNLOP: PUSHJ P,GETC ;GET A CHAR
POPJ P,
JUMPE C,LSNLOP ;EAT NULLS
MOVE T1,@1(P1) ;GET LSN BIT
CAIE P2,1 ;ALREADY SEEN IT?
SETZ T1, ;YES, DON'T LOOK AT IT AGAIN
TRNE T1,1 ;LSN?
MOVEI P2,7 ;YES, EAT 7 CHARS
SOJG P2,LSNLOP ;LOOP FOR EACH CHAR
JRST CPOPJ1
PRGEND
TITLE GETC - INPUT A CHAR
;SKIP IF OK
;ELSE NOSKIP
;NOSKIP WITH C=ERROR BITS
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY GETC
EXTERN ICH,RNGHDR,CPOPJ1,IINS,PRSIN
GETC: MOVE C,ICH ;GET INPUT CH
HRRZ C,RNGHDR(C) ;GET ADR RING HDR
SOSGE 2(C) ;MORE CHARS IN BUF?
JRST GETC9
ILDB C,1(C) ;YES, GET ONE
JRST CPOPJ1
GETC9: PUSHJ P,IINS ;NO, INPUT A BUF
IN
JRST GETC ;TRY AGAIN
JRST PRSIN ;NO, REAL ERROR
PRGEND
TITLE PRSIN
SEARCH PRS,UUOSYM
TWOSEG
RELOC 400000
ENTRY PRSIN
EXTERN ICH,SIXO,IINS,VERBO,SAVE1,OCTO
PRSIN: PUSHJ P,SAVE1 ;SAVE P1
PUSHJ P,IINS ;GET ERROR BITS
GETSTS P1
TRNN P1,IO.ERR ;FAILED BECAUSE EOF?
JRST PRSIN2 ;YES
MOVEI T1,ERRM
PUSHJ P,VERBO
PRSIN2: MOVE C,P1 ;RESTORE ERROR BITS
POPJ P,
ERRM1: MOVE T1,ICH ;TYPE DEVICE NAME
DEVNAM T1,
HALT
PJRST SIXO
ERRM2: MOVE T1,P1 ;TYPE THE STATUS
PJRST OCTO
ERRM1
ERRM2
ERRM: VB ER.EAT,"?",PRSIN,<Input error ^ for ^>
PRGEND
TITLE OINS - XCT AN OUTPUT INSTRUCTION
;CALL:
; PUSHJ P,OINS
; FOO 0,@FOO(FOO)
;NOSKIP
;SKIP
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY OINS
EXTERN OCH,IINS
OINS: SKIPA T1,OCH ;GET THE CH
;FALL TO IINS
PRGEND
TITLE IINS - XCT AN INPUT INSTRUCTION
;CALL:
; PUSHJ P,IINS
; FOO 0,@FOO(FOO)
;NOSKIP
;SKIP
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY IINS
EXTERN ICH,CPOPJ1
IINS: MOVE T1,ICH ;BUILD THE INS
LSH T1,^D23
ADD T1,@(P)
AOS (P)
XCT T1 ;DO IT
POPJ P,
JRST CPOPJ1
PRGEND
TITLE FNDNAM - FIND ABBREVIATED NAME IN TABLE
;T1 PASSES ABBR
;T2 PASSES AOBJN POINTER TO TABLE OF NAMES
;NO SKIP IF UNSUCCESSFUL
;SKIP RETURN:
;T2=INDEX INTO TABLE
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY FNDNAM
EXTERN CPOPJ1,SAVE3,PRSUKN
FNDNAM: PUSHJ P,SAVE3 ;SAVE P1-P3
SETO P1, ;MATCH MASK
TDZA T3,T3 ;WIN FLAG
FNDNM2: LSH P1,-6 ;BUILD UP THE MASK
TDNE T1,P1
JRST FNDNM2
MOVE P2,T2 ;SAVE INITIAL POINTER
FNDLP: MOVE P3,(T2) ;GET TABLE ENTRY
XOR P3,T1 ;COMPARE
JUMPE P3,FNDWON ;EXACT MATCH WINS
ANDCM P3,P1 ;CLOSE ENOUGH?
JUMPN P3,FNDNM1
JUMPN T3,PRSUKN ;YES, 2ND WIN AMBIGUOUS
MOVE T3,T2 ;SAVE ADR OF WIN
FNDNM1: AOBJN T2,FNDLP ;LOOP THROUGH TABLE
SKIPN T2,T3 ;RECALL WIN
JRST PRSUKN
FNDWON: SUB T2,P2 ;COMPUTE INDEX
TLZ T2,-1
JRST CPOPJ1
PRGEND
TITLE PRSUKN
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY PRSUKN
EXTERN SIXO,SAVE1,VERBO
PRSUKN: PUSHJ P,SAVE1
MOVE P1,T1
MOVEI T1,ERRM
PJRST VERBO
ERRM1
ERRM: VB ER.EAT,"?",PRSUKN,<Unknown or ambiguous abbreviation ^>
ERRM1: MOVE T1,P1
PJRST SIXO
PRGEND
TITLE CRLF
TWOSEG
RELOC 400000
ENTRY CRLF
CRLF: BYTE (7)15,12
PRGEND
TITLE OPN
TWOSEG
RELOC 0
ENTRY OPN
OPN: BLOCK 3 ;ARGS FOR OPEN UUO
PRGEND
TITLE ICH - INPUT CH
TWOSEG
RELOC 0
ENTRY ICH
ICH: BLOCK 1 ;INPUT CH
PRGEND
TITLE OCH - OUTPUT CH
TWOSEG
RELOC 0
ENTRY OCH
OCH: BLOCK 1 ;OUTPUT CH
PRGEND
TITLE FREMEM
TWOSEG
RELOC 0
ENTRY FREMEM
FREMEM: BLOCK 1 ;ADR FREE CHAIN
PRGEND
TITLE RNGHDR - TABLE OF POINTERS TO RING HDRS
;INDEX BY CH
;LH=ADR OUTPUT RING HDR
;RH=ADR INPUT RING HDR
TWOSEG
RELOC 0
ENTRY RNGHDR
RNGHDR: BLOCK 20
PRGEND
TITLE FOO - SCR SPACE
SEARCH PRS
TWOSEG
RELOC 0
ENTRY FOO
FOO: BLOCK FOOSIZ
PRGEND
TITLE FIL
TWOSEG
RELOC 0
ENTRY FIL
FIL: BLOCK 4 ;ARGS FOR LOOKUP/ENTER UUO
PRGEND
TITLE PTH
SEARCH PRS
TWOSEG
RELOC 0
ENTRY PTH
PTH: BLOCK SFDS+4 ;ARGS FOR PATH UUO
PRGEND
TITLE SAVE1 - SAVE P1
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SAVE1
EXTERN CJRA,RET1
SAVE1: EXCH P1,(P)
HRL P1,P
PUSHJ P,CJRA
SOS -1(P)
JRST RET1
PRGEND
TITLE SAVE2 - SAVE P1-P2
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SAVE2
EXTERN CJRA,RET2
SAVE2: EXCH P1,(P)
HRL P1,P
PUSH P,P2
PUSHJ P,CJRA
SOS -2(P)
JRST RET2
PRGEND
TITLE SAVE3 - SAVE P1-P3
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SAVE3
EXTERN CJRA,RET3
SAVE3: EXCH P1,(P)
HRL P1,P
PUSH P,P2
PUSH P,P3
PUSHJ P,CJRA
SOS -3(P)
JRST RET3
PRGEND
TITLE SAVE4 - SAVE P1-P4
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY SAVE4
EXTERN CJRA,RET3
SAVE4: EXCH P1,(P)
HRL P1,P
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSHJ P,CJRA
SOS -4(P)
POP P,P4
;FALL TO RET3
PRGEND
TITLE RET3
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY RET3
EXTERN RET2
RET3: POP P,P3
;FALL TO RET2
PRGEND
TITLE RET2
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY RET2
EXTERN RET1
RET2: POP P,P2
;FALL TO RET1
PRGEND
TITLE RET1
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY RET1
EXTERN CPOPJ1
RET1: POP P,P1
;FALL TO CPOPJ1
PRGEND
TITLE CPOPJ1 - SKIP RETURN
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CPOPJ1
EXTERN CPOPJ
CPOPJ1: AOS (P)
;FALL TO CPOPJ
PRGEND
TITLE CPOPJ
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CPOPJ
CPOPJ: POPJ P,
PRGEND
TITLE CJRA
SEARCH PRS
TWOSEG
RELOC 400000
ENTRY CJRA
CJRA: JRA P1,(P1)
END