File LOAD.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/OS/8 LOAD - A SYSTEM UTILITY - D.E. WREGE

/THIS UTILITY PROGRAM IS USED TO LOAD INDIVIDUAL FILES
/DUMPED INTO A DUMP FILE USING THE "DUMP" UTILITY.

/LOADING INFORMATION:
/	.LOAD DUMP(9)$
/	.SA SYS DUMP

/INPUT IS VIA THE STANDARD COMMAND DECODER (NORMAL MODE)
/FOR INITIAL FILE SPECIFICATION, OUTPUT BEING A DEVICE ONLY.

/	*OUTDEV:<INDEV:DUMPFILE [/OPTIONS]

/SOMEDAY IT IS MY INTENTION TO ADD THE FOLLOWING OPTIONS:

/	/D	CHECK OUT DEVICE FOR DUPLICATE FILENAMES
/		AND USE THE ONE WITH THE MOST RECENT DATE WHEN
/		THERE IS A CONFLICT.(NOT IMPLEMENTED).
/	/F	ENABLE MOUNT REQUEST.(NOT IMPLEMENTED.

/	/L	LIST FILES IN DUMPFILE ONLY ON CONSOL
/		DON'T TRANSFER ANY
/	/N	DON'T LIST FILES WHILE TRANSFERRING
/	/Q	QUERY FILES INDIVIDUALLY
/	/S	LOAD SPECIFIED FILES
/	/V	INVERT MATCH(NOT IMPLEMENTED)

/THE /S OPTION WILL RE-ENTER THE COMMAND DECODER IN SPECIAL
/MODE FOR ADDITIONAL FILE SPECIFICATIONS REGARDING WHICH FILES
/ARE TO BE LOADED FROM THE DUMP FILE.  THE ACTUAL TRANSFER
/TAKES PLACE AFTER RECEIPT OF AN ALTMODE TERMINATOR FROM THE
/COMMAND DECODER LINE.


/THE SCHEME OF THINGS:

/1. DO INITIAL COMMAND DECODE; SAVE OUTDEV # AND INPUT DEVICE
/2. READ INPUT DUMP HEADER
/    IF NOT /S OPTION GO TO 3., OTHERWISE:
/	A. CONSTRUCT TABLE OF FILES NOT TO TRANSFER
/	B. SPECIAL MODE DECODE NAMES
/	C. DO WILDCARD LOOKUP AND CHANGE TABLE ENTRIES
/	   TO TRANSFERABLE FILES.
/	D. IF LINE NOT ENDED BY ALTMODE THEN GO TO B.
/	E. MARK FILES NOT TO BE TRANSFERRED BY ZEROING
/	   FIRST WORD OF NAME.
/3. SAVE DIRECTORY ON SYSTEM SCRATCH BLOCKS 40-45.
/   *************************************************
/   NOTE:  MAX NUMBER OF FILES IN A DUMP FILE IS 6.
/   *************************************************
/4. READ OUTPUT DIRECTORY FOR PSEUDO-HANDLER WORK.
/   THIS DIRECTORY IS MAINTAINED IN CORE.
/5. PULL SWITCHERRO FOR USR FOOLING ABOUT DEVICE HANDLER.
/   THIS INCLUDES TRAPPING ^C'S.
/6. TRANSFER THE FILES UPDATING THE IN-CORE DIRECTORY
/7. WRITE OUT THE DIRECTORY TO THE DEVICE

NOMAT=2000+3000 /ADDRESS OF MATCH NO-MATCH TABLE *10 XRT, 0 /GENERAL PURPOSE XR. XRT2, 0 WILDXR, 7605-1 /POINTS INTO COMMAND DECODER TABLE STARXR, 0 /USED IN MKWILD TBLXR, 0 /POINTS TO MATCH TABLE FAKXR1, 0 /USED BY FAKE HANDLER FAKXR2, 0 /ALSO USED BY FAKE HANDLER *20 TEMP, 0 /GENERAL PURPOSE TEMPORARIES TEMP1, 0 TEMP2, 0 TEMP3, 0 CNTR, 0 /GENERAL PURPOSE COUNTERS CNTR1, 0 CNTR2, 0 INDEVN, 0 /INPUT DEVICE NUMBER INHAND, 0 /INPUT DEVICE HANDLER ENTRY POINT OUDEVN, 0 /OUT DEVICE NUMBER OUHAND, 0 /OUTPUT DEVICE HANDLER ENTRY POINT INDCB, 0 /INDEVICE DCB OUTDCB, 0 /OUT DEVICE DCB ENTRIE, 0 /ACCUMULATES # FILES IN DUMP TSIZE, 0 /TOTAL SIZE OF FILE DUMPBL, 0 /HAS NEXT BLOCK OF DUMP FILE DFLAG, 0 /NON-ZERO IF /D OPTION FFLAG, 0 /NON-ZERO IF /F OPTION QFLAG, 0 /NON-ZERO IF QUERRY /OPTION NFLAG, 0 /NON-ZERO IF /N OPTION LFLAG, 0 /NON-ZERO IF /L OPTION SFLAG, 0 /NON-ZERO IF /S OPTION VFLAG, 0 /NON-ZERO IF /V OPTION NULLT, 0 /IF NON-ZERO DON'T OUTPUT TO OUTDEV. /USED BY "IMAGE" /THE FOLLOWING ARE FOR WILD CARD LOOKUPS. /THE TRIAL FILENAME IS MASKED WITH THE MASK WORDS AND /THEN COMPARED TO THE WILDNAME FOR A MATCH /THE MASKS GET 00'S FOR "?" OR "*" ELSE 77'S /THE WILDNAME GETS 00'S FOR WILD CARDS ELSE THE 6-BIT NAME. WILDN1, 0 /AND MATCH NAME MASK1, 0 /CONTAINS MASK FOR FILENAME WILDN2, 0 MASK2, 0 WILDN3, 0 MASK3, 0 WILDEX, 0 /AND FOR THE EXTENSION MASKEX, 0 WDATE, 0 /SOMEDAY ALLOW DATE MATCH MDATE, 0 /AND MASK FOR DATE USR, 200 /ENTRY TO USR USRSIZ, 0 /USED FOR OUPUT FILE TEN ENTER /POINTERS AND STUFF FOR "NXTFIL" SEGPNT, 0 /POINTER INTO SEGMENT SEGCNT, 0 /POINTS TO NEXT SEGMENT IF ANY SEGINC, 0 /NON-ZERO IF ALL SEGMENTS IN CORE EMPTY, 0 /PRECEEDING EMPTY-1 FILST, 0 /BLOCK START OF NEXT FILE FILPNT, 0 /POINTER TO FILENAME NEXT FILE FILLEN, 0 /-LENGTH NEXT FILE FILDAT, 0 /DATE OF FILE PAGE
LOAD, JMS I (DECODE /DO INITIAL DECODE JMS I (CDCHECK /CHECK VALIDITY AND SET PAGE ZEROS JMS I (RDUMPF /READ THE DUMP FILE HEADER TAD SFLAG /SEE IF /S OPTION SZA CLA /SKIP IF ALL TO GO JMS I (SELECT /SELECT FILES CODE CDF 10 /GET SIZE TAD I (2001 /IN BLOCKS CDF 0 CLL RTR;RTR;RTR /FOR HANDLER CALL TAD (4010 /FIELD 1 WRITE DCA .+2 JMS I (7607 /WRITE THE HEADER 4010 /FUNCTION 2000 /IN FIELD 1 40 /ONTO SYSTEM SCRATCH JMP I (ERROR1 /HANDLER ERROR TAD (HEADSEG+377 /INIT GNEXTF DCA FILPNT /TO DO INITIAL READ TAD DUMPBL /GET CURRENT DUMP BLOCK DCA FILST /SET FILESTART THERE TAD (37 /FIRST BLOCK-1 DCA GNEXTS /INITIALIZATION DCA FILLEN /FAKE A ZERO LENGTH ONE DCA I (WRTDIR /ZERO WRITE DIRECTORY FLAG JMS I (INTERC /INTERCEPT ^C'S JMS GOUDIR /AND GET THE OUT DIRECTORY JMS I (XFER /AND DO ALL OF THE WORK JMS I (DIROUT /WRITE DIRECTORY OUT JMS I (RESTORE /AND RESTORE MONITOR HEAD DCA OUDEVN /CLEAR FOR RESTART DCA OUTDCB /STUFF ABOUT OUTDEV. JMS I (CRLF /NEW LINE FOR C.D. JMP LOAD /AND START OVER /READ IN THE OUT DIRECTORY FOR USR FAKER. GOUDIR, 0 TAD OUTDCB /CHECK IF FILE STRUCTURED FIRST SMA CLA /SKIP IF FILE STRUCTURED JMP I GOUDIR /NO NEED. TAD LFLAG /OR IF LIST ONLY SZA CLA /THERE IS NO NEED TO READ JMP I GOUDIR /FORGET IT. JMS I OUHAND /READ THE DIRECTORY 1400 /ALL 6 BLOCKS OUDIRECT /INTO CORRECT PLACE 1 /THAT'S WHERE IT IS JMP I (ERROR1 /TROUBLE READING JMP I GOUDIR /AND RETURN
/SUBROUTINE TO INSURE NEXT FILENAME FROM HEADER IS IN CORE. /FILPNT IS CHECKED FOR ABOVE HEADSEG+400. IF IT IS THEN /ANOTHER PAIR OF BLOCKS ARE READ WITH ONE=OVERLAP /CALL: JMS GNEXTF / ALL DONE RETURN / NORMAL RETURN GNEXTF, 0 TAD FILLEN /UPDATE WHERE WE ARE CIA /MAKE POSITIVE TAD FILST /TO WHERE NEXT ONE STARTS DCA FILST TAD FILPNT TAD (6 /INDEX TO NEXT ONE DCA FILPNT ISZ ENTRIE /SKIPS WHEN DONE SKP JMP I GNEXTF TAD FILPNT TAD (-HEADSEG-400 SPA CLA /SKIP IF NEED TO READ JMP GNEXT1 /NOPE: JUST CHANGE POINTER ISZ GNEXTS /NEXT VIRTUAL BLOCK JMS I (7607 /FROM SCRATCH BLOCKS 0300 /1-BLOCK+A LITTLE HEADSEG /INTO HEAD SEGMENT GNEXTS, 37 /THE SCRATCH BLOCK JMP I (ERROR1 /HANDLER ERROR TAD FILPNT /AND BACK UP POINTER TAD (-400 /INTO WHERE IT IS NOW DCA FILPNT GNEXT1, TAD FILPNT TAD (4 /POINT TO DATE DCA TEMP TAD I TEMP /GET DATE SNA /SKIP IF THERE IS ONE TAD I (SVDATE /USE MONITOR DATE DCA FILDAT /PUT IN PAGE ZERO ISZ TEMP TAD I TEMP /PICK UP -SIZE DCA FILLEN /SET LENGTH TAD I FILPNT /SEE IF A GOOD ONE SNA CLA /SKIP IF GOOD ONE JMP GNEXTF+1 /NO: IGNORE THIS ONE ISZ GNEXTF /TAKE NORMAL RETURN JMP I GNEXTF PAGE
/DO THE INITIAL COMMAND DECODE UPARAM=7643 /CD OPTIONS DECODE, 0 CDF 0 /FOR LOOPING CIF 10 JMS I USR /CALL THE COMMAND DECODER 5 0420 /.DP DEFAULT EXT. JMP I DECODE /CHECK COMMAND DECODE CDCHECK,0 CDF 10 /CHECK VALIDITY TAD I (UPARAM /PICK UP /D DATE OPTION AND (400 /MASK IT OUT DCA DFLAG /SET DATE FLAG CLA IAC AND I (UPARAM /GET /L OPTION DCA LFLAG /SET LIST ONLY FLAG TAD I (UPARAM+1 AND (2000 /PICK OUT /N OPTION DCA NFLAG /SET PRDELETE FLAG TAD I (UPARAM+1 AND (200 /PICK OUT /Q OPTION DCA QFLAG /SET Q FLAG TAD I (UPARAM+1 AND (40 /PICK OUT /S OPTION DCA SFLAG /SET S FLAG TAD I (UPARAM+1 AND (4 /MASK OUT /V OPTION DCA VFLAG TAD I (UPARAM /GET USER PARAMETERS AGAIN AND (100 /PICK OUT /F OPTION DCA FFLAG /AND SET FLAG TAD I (7617 /GET INDEV NUMBER CDF 0 AND (17 /ONLY INTERESTED IN NUMBER SNA /USER MUST SPECIFY INPUT FILE JMP I (LOAD /ASSUME NULL INPUT DCA INDEVN /SET IT CDF 10 TAD I (7620 /GET INBLOCK START DCA DUMPBL /SET DUMP BLOCK TAD I (7600 /GET OUT DEVICE CDF 0 SZA /CHECK IF SPECIFIED JMP CDCLEAN /CLEAN UP OPTIONS TAD LFLAG /NULL OUTPUT=BETTER BE /L SNA /SKIP IF O.K. JMP I (ERROR2 /NO OUTPUT DEVICE FOR TRANSFER SKP CDCLEA, DCA OUDEVN /SET OUT DEVICE NUMBER TAD OUDEVN /GET BACK JMS I (GETDCB /GET THE DCB TABLE ENTRY DCA OUTDCB /SAVE FOR LATER CHECKS TAD INDEVN /AND INDEVICE JMS I (GETDCB /GET THE DCB FOR IT DCA INDCB /STASH FOR LATER TAD QFLAG /OVERRIDES /N AND /L SNA CLA JMP .+3 DCA LFLAG /REMOVE /L OPTION DCA NFLAG /REMOVE /N OPTION TAD LFLAG /CHECK /L SNA CLA JMP .+3 DCA NFLAG /AS IT OVERRIDES /N DCA DFLAG /AND /D IS MEANINGLESS TAD DUMPBL /GET DUMP BLOCK SZA CLA /IF ZERO DEVICE MUST BE NON-FILE STRUCTURED JMP LDHAND /O.K. GO LOAD HANDLERS NOP /ISZ DUMPBL FOR NO REWIND /BUT NEED NOP FOR PTR: TAD INDCB /BETTER CHECK SPA CLA /SKIP IF NON-FILE STRUCTURED JMP I (ERROR3 LDHAND, JMS LOADHN /LOAD THE HANDLERS JMP I CDCHECK /AND RETURN /ROUTINE TO LOAD THE HANDLERS LOADHN, 0 TAD (7201 /NOW LOAD THE HANDLERS DCA .+5 /RESTORE WHERE TAD INDEVN /GET INDEV NUMBER CIF 10 JMS I USR /AND LOAD IT 1 7201 /ALLOW 2-PAGE HLT /CAN'T HAPPEN TAD .-2 /GET HANDLER ENTRY DCA INHAND /PUT IN PAGE ZERO TAD (6601 /NOW FOR OUT HANDLER DCA .+7 TAD OUDEVN SNA JMP I LOADHN /MUST BE /L ONLY CIF 10 JMS I USR /AND LOAD OUT HANDLER 1 6601 HLT /CAN'T HAPPEN TAD .-2 DCA OUHAND /PUT HANDLER ADDRESS AWAY JMP I LOADHN /HAVE A GOOD DECODE PAGE
/THIS IS THE ROUTINE THAT DOES ALL OF THE TRANSFERS. /THE TABLE OF CONTENTS AND ALL OF THAT CRAP HAS TO /HAVE BEEN SET UP SO THAT ALL THIS ROUTINE NEEDS TO DO IS /CALL "GNEXTF" TO OPTAIN POINTERS ETC. XFER, 0 JMS I (GNEXTF /GET POINTERS ETC TO NEXT FILE JMP I XFER /ALL DONE!!!!! JMS I (PRCRNM /PRINT THE NAME (WITH CR LF) TAD LFLAG /NOW SEE IF LIST ONLY SZA CLA /SKIP IF NOT JMP XFER+1 /WAS LIST ONLY TAD QFLAG /HOW ABOUT QUERY? SNA CLA /SKIP IF /Q JMP .+3 /NOPE: DON'T BOTHER JMS I (SKPYES /SKIP IF YES JMP XFER+1 /NO:IGNORE IT /IT'S A TRANSFER!!!!! TAD OUTDCB /GET OUTDEV DCB SMA CLA /SKIP IF FILE STRUCTURED JMP XFER6 /SKIP A BUNCH OF STUFF... /CHECK OUT FOR LATEST DATE HERE /CHECK OUT FOR NO PREDELETE HERE. TAD FILPNT /LETS DO A PRE-DELETION DCA USRC1 /PUT FILENAME IN TAD OUDEVN /GET OUT-DEVICE NUMBER JMS I (FAKUSR /USE FAKE HANDLER CIF 10 JMS I USR /DELETE IT 4 /CLOSE USRC1, 0 /GETS NAME POINTER 0 /LENGTH MEANS DELETE ONLY CLA /ERROR JUST MEANS IT WASN'T THERE JMS I (UNFAKE /PUT HANDLER BACK XFER1, TAD FILLEN /GET LENGTH CIA /MAKE POSITIVE AND (7400 /SEE IF WE CAN USE DEFINITE ENTER SZA CLA /SKIP IF WE CAN JMP XFER2 /NOPE: MUST USE INDEFINITE TAD FILPNT /FIRST PUT IN FILE POINTER DCA USRC2 /FOR THE ENTER TAD FILDATE /FIX THE DATE CDF 10 DCA I (DATE /FOR PRESERVATION CDF 0 TAD FILLEN /NOW CONSTRUCT THE SIZE CIA /MAKE POSITIVE CLL RTL;RTL /OVER 4 BITS XFER2, TAD OUDEVN /FOR FAKE STUFF JMS I (FAKUSR /USE FAKE HANDLER CIF 10 JMS I USR /ENTER TENATIVE 3 USRC2, 0 /NAME GOES HERE 0 /-SIZE GOES HERE JMP I (NOROOM /WAS NOT ENOUGH ROOM JMS I (UNFAKE /PUT HANDLER BACK TAD .-3 /GET SIZE:MAY HAVE BEEN INDEFINITE CIA /MAKE POSITIVE CLL /FOR POSSIBLY BIG FILES TAD FILLEN /SUBT FILE LENGTH SZA SNL CLA /SKIP IF WILL FIT JMP I (NOROOM /SORRY ABOUT THAT. ISZ I (WRTDIR /FROM HERE ON MUST WRITE DIRECTORY XFER6, TAD INDCB /GET INDEV DCB WORD TO SEE SPA CLA /IF WE NEED TO READ INTERMEDIATE JMP XFER3+1 /NOPE: IS FILE STRUCTURED TAD FILST /WERE WE WANT TO BE CIA /SUBTR FROM WERE WE ARE TAD DUMPBL /CALC HOW MANY BLOCKS TO SKIP SNA /SKIP IF ANY TO SKIP JMP XFER3+1 /NOPE: WE ARE READY DCA XFER3 /STASH - BLOCKS ISZ NULLT /SET NO OUTPUT JMS I (IMAGE /READ THAT STUFF 1;1 /NO REWIND OF MAGTAPE/CASSETS XFER3, 0 /HOW MUCH TAD FILST /UPDATE WHERE WE ARE DCA DUMPBL DCA NULLT /THIS TIME WE WANT TO COPY THEM TAD USRC2 /GET OUTPUT BLOCK NUMBER SNA /IF ZERO LET'S NOT REWIND IAC /MAGTAPES OR CASSETS DCA XFER4+1 /DESTINATION BLOCK TAD FILST /SOURCE START DCA XFER4 /PUT IN SOURCE IMAGE CALL TAD FILLEN /AND NUMBER OF BLOCKS DCA XFER4+2 /IN IMAGE CALL JMS I (IMAGE /NOW COPY THEM XFER4, 0;0;0 TAD FILLEN /NOW UPDATE WHERE WE ARE CIA /MAKE POSITIVE TAD FILST DCA DUMPBL /AND UPDATE CURRENT INPUT POSITION /IT IS TIME TO CLOSE THE FILE TAD FILPNT /GET POINTER TO FILENAME DCA XFER5 /AND PUT IN USR CLOSE CALL TAD FILLEN /PICK UP HOW BIG CIA /MAKE POSITIVE DCA XFER5+1 /PUT IN USR ARG TAD OUTDCB /NOW TO SEE IF WE NEED RAL /TO FAKE OUT USR CLA /WE WON'T IF OUTDEV IS TAD OUDEVN /NON-FILE STRUCTURED SZL /SKIP IF NON-FILE STRUCTURED JMS I (FAKUSR /FAKE OUT THE USR AGAIN CIF 10 /AND CLOSE THE FILE IN CORE JMS I USR /OR WRITE AN EOF 4 XFER5, 0;0 HLT /CAN'T HAPPEN WE CHECKED EVERYTHING JMS I (UNFAKE JMS I (CINTER /CHECK FOR ^C JMP XFER+1 /DO IT TO THE NEXT FILE JMP I (7600 /LET TRAP DO THE WORK PAGE
/COME HERE WHEN THERE IS NO ROOM FOR FILE NOROOM, JMS I (UNFAKE /WE COULD HAVE IN WRONG TAD OUDEVN /WE NEED TO CLEAR POSSIBLE TAD (7757 /TENATIVES BY OURSELVES DCA TEMP /POINTER TO DCB TABLE CDF 10 TAD I TEMP /GET DCB WORD AND (7770 /CLEAR OUT TENATIVE BLOCK # DCA I TEMP /AND PUT BACK CDF 0 /BACK TO THIS FIELD 6032 /CLEAR KEYBOARD FLAG TO GET RID OF ^O TAD (NOROMM /AND TELL THE USER JMS I (PRINT /THERE WAS INSUFFICIENT ROOM JMP I (XFER+1 /TRY NEXT FILE
/SUBROUTINE TO CHECK FOR NAME MATCH. /ENTER WITH POINTER TO NAME-1 CANDIDATE (IN FIELD 1) IN AC. /THE WILD NAME MASK AND MATCH MUST BE IN PAGE ZERO "MASKN" /AND "WILDNM". RETURN INDICATES MATCH/NO-MATCH CONDITION. /USES CNTR,TEMP,XRT,XRT2. /CALL: TAD PNTR /TO FIELD 1 NAME-1 / JMS MATCH / NOMATCH RETURN / MATCH RETURN MATCH, 0 DCA XRT /SAVE NAME POINTER TAD (WILDN1-1 /AND SET WILD POINTER DCA XRT2 TAD (-5 /MATCH 4 NAMES+DATE DCA CNTR MATCHL, TAD I XRT2 /GET WILDNX CIA /FOR MATCH CHECK DCA TEMP TAD I XRT2 /GET MASKNX CDF 10 /TO NAME FIELD AND I XRT /MASK NAME CDF 0 TAD TEMP /SUBTR FROM WILDNX SZA CLA /SKIP IF MATCHES JMP I MATCH /NOPE... EXIT ISZ CNTR /DONE?? JMP MATCHL /NO: CHECK NEXT ISZ MATCH /GOT ONE: TAKE SECOND RETURN JMP I MATCH /GET A DCB TABLE ENTRY FOR DEVICE NUMBER IN AC. GETDCB, 0 TAD (7757 /ADD START OF TABLE DCA TEMP CDF 10 TAD I TEMP /GET THE TABLE ENTRY CDF 0 /BACK TO THIS FIELD JMP I GETDCB /AND RETURN /INIT STUFF FOR GET NEXT FILE THING INITLO, 0 TAD (1777 /THAT'S WHERE IT STARTS -6 DCA FILPNT CDF 10 /TO WHERE DIRECTORY IS KEPT STA /(PLUS ONE) TAD I (2002 /GET -HOW MANY -1 DCA FILCNT /SAVE NEGATIVE FILE COUNT-1 CDF 0 JMP I INITLO FILCNT, 0 /GET POINTER TO NEXT FILE NXTFIL, 0 TAD FILPNT /GET FILE POINTER TAD (6 /MOVE TO NEXT ONE DCA FILPNT /SET POINTER ISZ FILCNT /COUNT THIS ONE ISZ NXTFIL /NOT DONE YET JMP I NXTFIL
/SUBROUTINE TO PRINT NAME IN FIELD 0 POINTED TO /BY FILPNT. OUTPUTS INITIAL CRLF IF CALLED BY PRCRNM /DOESN'T IF CALLED VIA PRNAME PRCRNM, 0 JMS I (CRLF JMS PRNAME JMP I PRCRNM PRNAME, 0 STA TAD FILPNT /GET FILEPOINTER DCA XRT /USE XR TAD I XRT /GET NAME1 DCA PRNMT /MOVE INTO TEXT TAD I XRT /GET NAME2 DCA PRNMT+1 TAD I XRT /NAME3 DCA PRNMT+2 TAD I XRT /EXTENSION DCA PRNMT+4 TAD (PRNMT JMS I (PRINT /PRINT NAME TAD (". JMS I (PCH TAD (PRNMT+4 /AND EXTENSION JMS I (PRINT JMP I PRNAME PRNMT, ZBLOCK 6 /ROUTINE TO ASK FOR YES OR NO. /ANYTHING BUT "Y" IS THE SAME AS NO /SKIPS IF ANSWER WAS YES SKPYES, 0 TAD ("? JMS I (PCH /PRINT ? 6031 /WAIT FOR A RESPONSE JMP .-1 JMS I (CINTER /CHECK FOR ^C SKP /SKIP WAS NOT JMP I (7600 /DO PROPER ABORT 6036 /GET CHAR AGAIN & CLEAR FLAG TAD (-"Y /SEE ABOUT "Y" SZA CLA /SKIP IF "Y" JMP .+3 /IS NO ISZ SKPYES /WAS "Y" SO TAKE SECOND RETURN TAD ("Y-"N TAD ("N JMS I (PCH /ECHO IT JMP I SKPYES PAGE
/THIS SUBROUTINE READS THE INDEVICE DIRECTORY AND BUILDS A /TABLE OF POINTERS TO EACH FILE. THIS IS THE "NO-MATCH" TABLE /FROM WHICH THE WILD CARD WORK WILL BE DONE. SETTAB, 0 CLA CLL /FOR BAD GUYS... JMS I (INITLOK /INIT POINTERS FOR "NXTFIL" TAD (NOMAT-1 /SET POINTER TO NO-MATCH TABLE DCA XRT /USE GEN PURPOSE XR SETTA1, JMS I (NXTFIL /GET AN ENTRY JMP SETTA2 /DONE.... TAD FILPNT /INTO NO-MATCH TABLE TAD (-2000 /MAKE THEM RELATIVE CDF 10 /NOW TO PUT FILENAME POINTER DCA I XRT CDF 0 /BACK TO THIS FIELD JMP SETTA1 SETTA2, CDF 10 /NOW CLEAR LAST DCA I XRT /TABLE ENTRY FOR END OF LIST CDF 0 JMP I SETTAB
/THIS SUBROUTINE TURNS THE NEXT CD ENTRY INTO A SET OF /MASKS AND WILDNAMES. THE NEXT ENTRY IS POINTED TO BY /WILDXR. /CALL: JMS MKWILD / RET1 /NO MORE CD ENTRIES / RET2 /MASKS AND WILDNAMES SET MKWILD, 0 CDF 10 /FIRST CHECK FOR AN ENTRY TAD I WILDXR /GET THE DEVICE NUMBER CDF 0 /IN CASE ERROR RETURN SNA CLA /SKIP IF AN ENTRY JMP I MKWILD /NO MORE RETURN CDF 10 /NOW COPY NAME INTO WILDN1-WILDEX TAD I WILDXR SNA TAD (5200 DCA WILDN1 TAD I WILDXR DCA WILDN2 TAD I WILDXR DCA WILDN3 TAD I WILDXR SNA TAD (5200 DCA WILDEX CDF 0 /NO MORE NEED FOR FIELD 1 TAD WILDN1 /CHECK NAME FOR "*" TAD (-5200 SZA CLA /SKIP IF NAME FIELD="*" JMP STAREX /NO:CHECK EXTENTION FIELD STA /NAME IS "*" SO TURN FIELD INTO "?"'S DCA WILDN1 STA DCA WILDN2 STA DCA WILDN3 STAREX, TAD WILDEX /CHECK EXTENSION FIELD FOR "*" TAD (-5200 SZA CLA /SKIP IF A "*" JMP QUESTM /GO CHECK FOR "?" STA DCA WILDEX /TURN EXTENSION FIELD INTO "??". QUESTM, TAD (WILDN1-1 /SET AUTOINDEX FOR WILD STUFF DCA XRT TAD (-4 /4 NAME WORDS DCA CNTR TAD I XRT /GET A NAME JMS CHKQUES /CONVERT STA TAD XRT DCA XRT /BACK UP XR TAD TEMP2 /GET CONVERTED NAME DCA I XRT /STASH TAD TEMP1 /GET MASK DCA I XRT ISZ CNTR /DONE?? JMP QUESTM+4 /NOT YET ISZ MKWILD /TAKE SECOND RETURN JMP I MKWILD /DONE... /CHECK PACKED 6-BIT FOR 77 CODE - RETURN MASK IN TEMP1 /AND NEW WILDNAME WORD IN TEMP2 CHKQUE, 0 DCA TEMP TAD TEMP RTR;RTR;RTR /CHAR 1 OVER JMS CHKSUB /CONVERT TO MASK ETC JMP I (ERROR3 /"*" FOUND CLL RTL;RTL;RTL /BACK OVER DCA TEMP1 /SAVE 6-BIT MASK TAD TEMP3 /GET 6-BIT CHAR CLL RTL;RTL;RTL /FOR WILDNAME DCA TEMP2 TAD TEMP JMS CHKSUB /CONVERT THAT ALSO JMP I (ERROR3 /"*" FOUND TAD TEMP1 DCA TEMP1 /FULL WORD OF MASK TAD TEMP3 TAD TEMP2 DCA TEMP2 /FULL WORD OF WILDNAME JMP I CHKQUE /AND RETURN /CHECK A CHARACTER FOR "*" AND PRODUCE MASK CHAR AND /CHAR FOR WILDNM. RETURN WITH MASK CHAR IN AC AND WILDNM /CHAR IN TEMP3. /CALL: JMS CHKSUB / RET1 /"*" FOUND / RET2 /NORMAL CHKSUB, 0 AND (77 /MASK 6-BIT CHAR SNA JMP NULCHR /TREAT NULLS SPECIAL TAD (-52 /CHECK FOR "*" SNA JMP I CHKSUB /FIRST RETURN ISZ CHKSUB TAD (-77+52 SZA TAD (77 /RESTORE CHAR DCA TEMP3 /SAVE IN TEMP3 TAD TEMP3 /GET AGAIN SZA CLA /IF WAS WILD MASK=0 TAD (77 /IF NOT MASK=77 JMP I CHKSUB /RETURN WITH MASK IN AC NULCHR, DCA TEMP3 /CLEAR CHAR ISZ CHKSUB JMP .-4 /AND SET MASK TO 77 PAGE
/IMAGE TRANSFER ROUTINE - INPUT IS USING HANDLER AT INHAND /OUTPUT USES HANDLER AT OUHAND. BUFFER IS ALL OF FIELD 1. /CALL: JMS I (IMAGE / STRT BLK # /INDEVICE / STRT BLK # /OUTDEV / -#BLOCKS IMAGE, 0 TAD I IMAGE /PICK UP START OF INPUT DCA INBLOK /SAVE FOR HANDLER CALL ISZ IMAGE /POINT TO OUTBLOCK TAD I IMAGE DCA OUBLOK /SAVE START OF OUTPUT ISZ IMAGE /POINT TO SIZE TAD I IMAGE /GET IT DCA IMSIZE /SAVE FOR CALC ISZ IMAGE /POINT TO RETURN TAD (2610 /BIG BLOCK FUNCTION WORD DCA INBLOK-2 /STICK IN HANDLER CALL IMAGL1, TAD IMSIZE /CHECK IF ROOM FOR BIG TRANSFER CLL /IN CASE BIG FILE TAD (13 /IN EVEN BLOCKS SZL /SKIP IF CAN DO IT JMP IMAGL2 /NO:DO FINAL TRANSFER DCA IMSIZE /SAVE HOW MUCH LEFT JMS COPY /COPY IT JMP IMAGL1 /AND DO MORE IMAGL2, CLA CLL /GARBAGE IN AC TAD IMSIZE /DO FINAL READ/WRITE CIA /MAKE POSITIVE SNA /SKIP IF ANY LEFT JMP I IMAGE /CAME OUT EVEN-WE ARE DONE CLL RTR;RTR;RTR /MAKE FUNCTION WORD BLOCKS TAD (10 /PUT IN FIELD DCA INBLOK-2 /SAVE IN HANDLER CALL JMS COPY /AND COPY THAT PART JMP I IMAGE /DONE IMSIZE, 0
/SUBROUTINE TO COPY BLOCKS COPY, 0 CLA STL RAR /SET WRITE BIT TAD INBLOK-2 /GET IN FUNCTION DCA OUBLOK-2 /TO MAKE OUT FUNCTION WORD JMS I INHAND /READ THE INPUT 0 /IN FUNCTION WORD 2000 /USE MOST OF FIELD 1 INBLOK, 0 /IN BLOCK NUMBER JMP I (ERROR1 /HANDLER ERROR JMS I (CINTER /MAY HAVE BEEN SYSHAND SKP JMP I (7600 /LET TRAP DO THE WORK TAD NULLT /SEE IF WE ARE TO REALLY COPY SZA CLA /SKIP IF WE ARE JMP OUBLOK+2 /NOPE: SKIP OVER WRITE JMS I OUHAND /AND DO THE OUTPUT 0 /OUT FUNCTION WORD 2000 /MOST OF FIELD 1 OUBLOK, 0 /THE BLOCK NUMBER JMP I (ERROR1 /HANDLER ERROR TAD INBLOK /UPDATE BLOCK NUMBER BY 17 BLOCKS TAD (13 DCA INBLOK TAD OUBLOK /AND OUTBLOCK BY 17 TAD (13 DCA OUBLOK JMS I (CINTER /MAY HAVE BEEN SYS HAND JMP I COPY JMP I (7600 /^C TYPED PAGE
/ROUTINE TO READ IN THE DUMP HEADER BLOCK INTO 12000-UP RDUMPF, 0 TAD DUMPBL /GET NEXT DUMP FILE BLOCK NUMBER DCA .+4 /PUT IN HANDLER CALL JMS I INHAND /FIRST READ ONE BLOCK 0211 /INTO FIELD 1 2000 0 /FIRST DUMPBLOCK HERE JMP I (ERROR1 ISZ DUMPBL /INDEX TO NEXT BLOCK CDF 10 /NOW CHECK IF FIRST HEADER WORD=-1 ISZ I (2000 /IF NOT AN ERROR JMP I (ERROR4 /PROBABLY IMPROPERLY POSSITIONED PAPER TAPE STA TAD I (2002 /GET -#FILES-1 DCA ENTRIES /REMEMBER THAT STA /CONSTRUCT HOW MUCH MORE TO READ TAD I (2001 /GET #BLOCKS HEADER-1 CDF 0 /IN CASE DONE SNA /IF ZERO WE ARE DONE JMP RDUMPE /DONE DCA TEMP /SAVE FOR NOW TAD TEMP CLL RTR;RTR;RTR /FOR HANDLER CALL TAD (10 /IN FIELD 1 DCA .+4 /PUT IN HANDLER CALL TAD DUMPBL /GET BLOCK NUMBER DCA .+4 /PUT IN HANDLER CALL JMS I INHAND /READ THE REST 0010 /CHANGED TO FUNCTION WORD 2400 /WERE REST GOES 0001 /BLOCK NUMBER JMP I (ERROR1 /HANDLER ERROR STA /LESS ONE TAD TEMP /UPDATE DUMPBL TAD DUMPBL /FOR START OF FILES DCA DUMPBL RDUMPE, JMS I (SETTAB /SET UP TABLE FOR WILDCARDS JMP I RDUMPF /AND RETURN
/SUBROUTINE TO INVERT THE MATCH TABLE. /THE USER NEEDS TO BE CAREFUL AS ALL PREVIOUS MATCHES /TO THIS POINT ARE INVERTED (FROM PREVIOUS CD'S. INVERT, 0 CDF 10 /TO CD TABLE TAD I (UPARAM+1 /GET OPTION WORD CDF 0 /BACK TO THIS FIELD SNA CLA /SKIP IF SET JMP I INVERT /NOPE - NO INVERSION REQUESTED TAD (NOMAT DCA TEMP /INIT TEMP TABLE CDF 10 /TO FIELD OF TABLE INVRTL, TAD I TEMP /PICK UP VALUE SNA /ZERO'S END LIST JMP INVERT+3 /FINISH UP AND QUIT TAD (4000 /INVERT IT DCA I TEMP ISZ TEMP /TO NEXT JMP INVRTL PAGE
/THIS IS THE CORE DEVICE HANDLER /THE USR IS MADE TO COME HERE BY A CALL TO FAKUSR. /THIS HANDLER SWAPS THE DESIRED BLOCK INTO /THE USR AREA AND WRITES THE BLOCK BACK INTO THE /INCORE DIRECTORY. FAKHND, 0 CDF 10 /ONLY CALLED BY USR TAD I FAKHND /GET CONTROL WORD DCA FHFUNC /SAVE IT. ISZ FAKHND /BUMP TO LOCATION (ALWAYS 1400 FROM USR) ISZ FAKHND /BUMP TO BLOCK NUMBER TAD I FAKHND /GET IT CDF 0 /IN THIS FIELD FOR A WHILE ISZ FAKHND /BUMP TO ERROR RETURN ISZ FAKHND /NOW TO GOOD RETURN (WE WONT FAIL) CLL RTR /MULTIPLY BY 400(8) RTR RAR TAD (OUDIRE-401 /ADD ON TO BEGINING OF DIRECTRY DCA XRT /XRT HAS DIRECTORY ADDRESS TAD (1377 /NOW SAVE USR BLOCK AREA DCA XRT2 /XRT2 HAS USR ADDRESS TAD (-400 /SET WORD TRANSFER COUNT DCA CNTR /ALWAYS ONE BLOCK TAD FHFUNC /SEE IF READ OR WRITE SMA CLA /SKIP IF WRITE JMP FHREAD /WAS READ.. CDF 10 TAD I XRT2 /GET A WORD FROM USR CDF 0 DCA I XRT /PUT A WORD IN IN CORE DIRECTORY ISZ CNTR JMP .-5 FAKHNR, CDF CIF 10 /BACK TO USR JMP I FAKHND /IN PROPPER FIELD FHREAD, TAD I XRT /GET A WORD FROM IN CORE DIRECTORY CDF 10 DCA I XRT2 /AND PUT IT IN USR AREA CDF 0 ISZ CNTR /ALL OF THEM JMP FHREAD JMP FAKHNR /GO BACK TO USR FHFUNC, 0
/THIS ROUTINE DOES THE SETUP OF THE INCORE /DIRECTORY HANDLER AND CHANGES THE REAL /HANDLERS ENTRY POINT IN THE MONITOR SO THAT /THE USR WILL CALL IT. FAKUSR, 0 DCA UNFAKE /SAVE DEVICE NUMBER TAD UNFAKE /INDEX INTO MONITORS RESIDENCY AND (17 /IN CASE DEFINITE ENTER TAD (7646 /TABLE DCA TABAD TAD (FAKHND /PUT OUR HANDLERS ADDRESS IN CDF 10 DCA I TABAD /MONITORS TABLE CDF 0 TAD UNFAKE /RETURN WITH DEVICE NUMBER IN AC JMP I FAKUSR UNFAKE, 0 TAD OUHAND /RESET MONITORS TABLE TO CDF 10 DCA I TABAD /POINT TO REAL HANDLER CDF 0 JMP I UNFAKE TABAD, 0
/ENTER HERE IF A BRANCH TO 7600 OR 7605 OCCURS FIXDIR, CLA /JUST IN CASE TAD WRTDIR /CHECK TO SEE IF WE HAVE TO SZA CLA /WRITE THE DIRECTORY ENDCHK, JMS DIROUT /WRITE OUT THE OUTPUT DIRECTORY JMS I (RESTORE /RESTORE 7600 IN FIELD 0 CIF CDF 0 /RETURN TO MONITOR JMP I (7605 MUSTWT, 0 SVDATE, 0 WRTDIR, 0 /SUBROUTINE TO WRITE OUT THE IN-CORE DIRECTORY /IF WRTDIR IS SET DIROUT, 0 /ROUTINE TO WRITE THE OUTPUT DIRECTORY TAD WRTDIR /AC#0 IF WE HAVE TO WRITE IT SNA CLA /SKIP TO WRITE DIRECTORY JMP I DIROUT TAD OUTDCB /AND MAKE SURE FILE STRUCTURED SMA CLA /SKIP IF FILE STRUCTURED JMP I DIROUT JMS I OUHAND /WRITE DIRECTORY BACK ONTO DEVICE 5400 OUDIRECTORY 1 JMP I (ERROR5 /IS HE IN TROUBLE... DCA WRTDIR /CLEAR WRITE DIRECTORY FLAG JMP I DIROUT /RETURN
/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF /ONE WE WANTED CTYPE, 0 DCA T2 /SAVE CHARACTER TAD (200 /GT RID OF PARITY KRS /SEE WHATS IN BUFFER CIA TAD T2 /COMPARE AGAINST DESIRED ONE SNA CLA /SKIP IF NOT ONE KSF /IS FLAG UP? JMP I CTYPE /NO... JUST RETURN KCC /CLEAR CHARACTER TAD ("^ /OUTPUT ^ JMS I (PTTY TAD T2 TAD (100 /CHAR JMS I (PTTY TAD (215 JMS I (PTTY TAD (212 JMS I (PTTY ISZ CTYPE /SKIP RETURN JMP I CTYPE T2, 0 PAGE
/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED CINTER, 0 TAD (203 /CHECK FOR ^C JMS I (CTYPE JMP UPPCK /NO CHECK FOR ^P JMP SPURGE /YES SET ALTMODE BIT UPPCK, TAD (220 JMS I (CTYPE JMP I CINTER /NOT EITHER ^P OR ^C SPURGE, ISZ CINTER JMP I CINTER
DATE=7666 /IN FIELD 1 /THIS ROUTINE MODIFIES THE THE MONITOR RETURN /LOCATIONS TO COME BACK TO LOAD AND SAVES WHAT /WAS THERE SO RESTORE CAN RESTORE THEM INTERC, 0 CDF 10 TAD I (DATE CDF 0 DCA I (SVDATE /SAVE MONITOR DATE TAD I (7600 /SAVE 7600,7601,7602,7605 DCA SCODE /AND REPLACE WITH TAD (5601 /JMP I .+1 DCA I (7600 /JMP I .+1 TAD I (7601 /FIXDIR DCA SCODE+1 /7605 GETS JMP 7600 TAD (FIXDIR DCA I (7601 /OUT DIRECTORY ON MANUAL ABORT TAD I (7602 /OR IF HANDLER PICKS UP ^C DCA SCODE+2 /AND TRIES TO GO TO MONITOR TAD I (7605 DCA SCODE+3 TAD (5200 DCA I (7605 JMP I INTERC /THIS ROUTINE SIMPLY RESTORES THE MONITOR /LOCATIONS TO THEIR ORIGINAL VALUE RESTORE,0 TAD I (SVDATE /RESTORE DATE CDF 10 DCA I (DATE CDF 0 TAD SCODE DCA I (7600 /RESTORE LOCATIONS TAD SCODE+1 DCA I (7601 TAD SCODE+2 DCA I (7602 TAD SCODE+3 DCA I (7605 JMP I RESTORE SCODE, 0;0;0;0
/THIS ROUTINE IS ENTERED WHENEVER /S OPTION IS GIVEN. /IT DOES A WHOLE BUNCH OF SPECIAL MODE DECODES AND /WILDCARD LOOKUPS ON THE DIRECTORY IN FIELD 1. /INPUT IS TERMINATED WITH AN ALTMODE. SELECT, 0 CIF 10 JMS I USR /DO A DECODE 5 /CD 5200 /SPECIAL MODE TAD (7605-1 /POINTER TO INPUT LIST DCA WILDXR /FOR MKWILD LOOK1, JMS I (MKWILD /MAKE A WILD NAME JMP CHKALT /END OF LIST:CHECK ALTMODE TAD (NOMAT-1 /SET POINTER TO MATCH/NO-MATCH TBL DCA TBLXR /FOR WILDCARD COMPARE LOOK2, CLA CLL /RID OF GARBAGE CDF 10 /TO NOMATABLE FIELD TAD I TBLXR /GET A POINTER CDF 0 /BACK TO THIS FIELD SNA /ZERO'S END LIST JMP LOOK1 /DO NEXT SPECIFIER SPA /SKIP IF NOT ALREADY SPECIFIED JMP LOOK2 /CHECK NEXT TABLE ENTRY TAD (2000-1 /MAKE ABSOLUTE POINTER-1 JMS I (MATCH /FOR MATCH: DO IT JMP LOOK2 /NO MATCH: CHECK NEXT TAD TBLXR /MATCH: FLAG THE FILE DCA TEMP /COPY POINTER CDF 10 /TO THE TABLE FIELD CLA STL RAR /SET BIT 0 TAD I TEMP /ADD INTO POINTER DCA I TEMP /AND PUT BACK WITH BIT 0 ON JMP LOOK2 /AND DO NEXT: FIELD IMMATERIAL CHKALT, JMS I (INVERT /INVERT IF /V REQUESTED CDF 10 /NOW TO CHECK FOR ALL DONE TAD I (UPARAM-1 /GET WORD WITH ALTMODE CDF 0 SMA CLA /SKIP IF SET JMP SELECT+1 /DO ANOTHER DECODE TAD (NOMAT-1 /NOW TO CLEAR NAMES NOT MATCHED DCA TBLXR /SET XR TO MATCH TABLE JMS I (LOADHN /RELOAD THE HANDLERS SINCE CD /REMOVED THEM. SELEC1, CLA CLL CDF 10 /NOW TO PICK UP TAD I TBLXR /GET AN ENTRY CDF 0 SNA /ZEROS END LIST JMP I SELECT /DONE SPA /SKIP IF A NO-MATCH JMP SELEC1 /A MATCH-LEAVE NAME ALONE TAD (2000 /MAKE ADDRESS ABSOLUTE DCA TEMP /FOR CLEAR CDF 10 DCA I TEMP /CLEAR NAME1 JMP SELEC1 /AND DO NEXT ONE PAGE
/ERROR MESSAGES AND PRINTING ROUTINES ERROR1, JMS ERROR ERR1M ERROR2, JMS ERROR ERR2M ERROR3, JMS ERROR ERR3M ERROR4, JMS ERROR ERR4M ERROR5, JMS ERROR ERR5M ERROR, 0 CLA CLL CDF 0 /JUST IN CASE TAD I ERROR JMS PRINT JMS CRLF JMP I (LOAD /PRINT CR/LF CRLF, 0 TAD (215 JMS PCH TAD (212 JMS PCH JMP I CRLF /ROUTINE TO PRINT PACKED ASCII PRINT, 0 DCA TEMP TAD I TEMP CLL RTR;RTR;RTR JMS PRNT6 /OUTPUT IT TAD I TEMP JMS PRNT6 ISZ TEMP JMP PRINT+2 PRNT6, 0 AND (77 /MASK CHAR SNA JMP I PRINT /0'S END LIST TAD (-40 SPA TAD (100 TAD (240 JMS PCH JMP I PRNT6 PCH, 0 DCA CHAR 6034 /GET TTY IN BUFFER TAD (-"O+100 /SEE IF ^O LEFT SNA CLA JMP PCH1 /YEP IGNORE STUFF TAD CHAR /NOPE: SO PRINT IT JMS PTTY JMP PCH2 /AND RETURN PCH1, TAD ("O-100 /TO PRINT IF THERE JMS I (CTYPE /PRINT IT ONCE ONLY PCH2, CLA CLL JMS I (CINTER /CHECK FOR ^C JMP I PCH /NOPE JMP I (7600 /LET INTERCEPT DO IT'S JOB PTTY, 0 6046 6041 JMP .-1 CLA CLL JMP I PTTY CHAR, 0 PAGE
ERR1M, TEXT \?HANDLER I/O ERROR.\ ERR2M, TEXT \?NO OUTPUT DEVICE SPECIFIED\ ERR3M, TEXT \?DUMP FILE NOT SPECIFIED\ ERR4M, TEXT \?NOT A DUMP FILE OR BADLY POSITIONED PAPER TAPE\ NOROMM, TEXT \ - SKIPPING, NOT ENOUGH ROOM\ ERR5M, TEXT \?ERROR WRITING DIRECTORY\ PAGE
HEADSEG=. OUDIRECT=HEADSEG+600 IFZERO OUDIRECT+2777-6600&4000 <+=BAD> /GIVES ERROR IF OUDIRECT WILL OVERLAP HANDLERS



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search