ON FILE 1 OF THIS TAPE YOU WILL FIND THE SOURCES AND KEYSHEETS. THE KEYSHEET IS THE INSTRUCTIONS FOR BUILDING THIS PRODUCT. PLEASE READ THE KEYSHEET AND THEN EXECUTE THE KEYSHEET AS A COMMAND FILE. EX. @KEYSHEETNAME.KS@ FPRINT.SR5uV ; ; FPRINT- ; FORMATTED FILE PRINTER ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CFPRINT .RB CFPRINT.RB ** .ENDC J .TITL BFPRINT .RB BFPRINT.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT FPRINT ; ENTRY POINT .EXTN CALL RTRN RCALL .EXTN LDBT .EXTN GETSW GETAR .EXTN WRLCH .EXTN STBI .EXTN MOVE CMOVE .EXTN .ASCB .EXTN SETSW .EXTN MKFLA ICH= COMCH ; INPUT CHANNEL LCH= CH1 ; DEFINE THE STACK CP= 1 ; AURG POINTER ZSW= CP+1 ; /Z SWITCH LIST= ZSW+1 ; LIST FILE NAME TMP= LIST+1 ; TEMPS FOR ALL KINDS OF THINGS TMP1= TMP+1 TABL= TMP1+1 ; ADDRESS OF FORMAT TABLE OUTRN= TABL+1 ; OUTPUT ROUTINE ADDRESS STAIP= OUTRN+1 ; POINTER TO STATI LISCH= STAIP+1 ; LcISTING CHANNEL OAERA= LISCH+1 ; OUTPUT AREA RAERA= OAERA+1 ; READ IN AREA POINTER SKPLF= RAERA+1 ; SKIP LINE FLAG FLIP= SKPLF+1 ; FLIP FLOP RDOFF= FLIP+1 ; OFFSET INTO INPUT READ AREA OLINP= RDOFF+1 ; OUTPUT LINE POINTER CFPOS= OLINP+1 ; FILE POSITI]ON FIRST= CFPOS+1 ; FIRST LOCATION TO BE PRINTED LAST= FIRST+1 ; LAST LOCATION TO BE PRINTED LOC= LAST+1 ; CURRENT LOCATION WDCNT= LOC+1 ; WORD COUNT W0= WDCNT+1 ; DATA STORAGE AREA W1= W0+1 W2= W1+1 W3= W2+1 W4= W3+1 W5= W4+1 W6= W5+1 W7= W6+1 X0= W7+1 X1= X0+1 X2= X1+1 X3= X2+1 X4= X3+1 X5= X4+1 X6= X5+1 X7= X6+1 FPEFG= X7+1 ; END OF FILE FLAG RDIN= FPEFG+1 ; READ IN AREA OLIN= RDIN+40 ; OUTPUT LINE AREA STATI= OLIN+200; INPUT FILE WORD AREA STACK= STATI+SCDBS+CFSIZ ; STACK SIZE  ; DEFINE THE FORMAT TABLE OFSETS FLOC= 0 ; LOCATION COUNTER FORMAT LINE FNOR= 1 ; NORMAL FORMAT LINE FIGN= 2 ; IGNORE FORMAT LINE FEND= 3 ; END OF LINE FORMAT STACK FPRINT: ISZ SSRTN,2 ; SET GOOD RETURN STA 0,CP,3 ; SAVE ARG POINTER C GETSW ; GET GLOBAL SWITCHES SW Z ; TEST /Z LDA 0,LPTNM ; AC0 => $LPT LDA 2,LS.W AND 1,2,SNR ; /L GLOBAL ? MOV 2,0 ; NO WIPE OUT $LPT STA 0,LIST,3 ; SAVE TENTATIVE LISTING FILE LDA 0,FDTAB ; FIND OUT WHAT TYPE OF OUTPUT WANTED STA 0,TMP,3 FPRI1: LDA 0,@T-MP,3 ; GET AN ENTRY ISZ TMP,3 COM# 0,0,SZR ; END OF TABLE ? AND# 0,1,SZR ; MATCH ?? JMP FPRI2 ; YES-YES ISZ TMP,3 ; NO - NEXT ENTRY ISZ TMP,3 JMP FPRI1 FDTAB: .+1 B.SW BYTTB ; BYTES FOU2 D.SW ; /D DECTB ; DECIMAL FOU1 H.SW ; /H HEXTB ; HEX FOU1 -1 ; NONE OF THE ABOVE OCTTB ; OCTAL FOU1 LPTNM: LPTN*2 LS.W: L.SW FPRI2: CLER FIRST ; FIRST = 0 STA 1,FPEFG,3 ; CLEAR END OF FILE FLAG ADC 1,1 ; SET LAST = STA 1,LAST,3 ; 64K WORDS LDA 0,@TMP,3 ; GET ADDRESS OF FORMAT TABLE STA 0,TABL,3 ISZ TMP,3 LDA 0,@TMP,3 ; GET ADDRESS OF OUTPUTROUTINE STA 0,OUTRN,3 LDA 0,CP,3 ; TEST THE ARGS STA 0,TMP,3 FPRI3: LDA 0,TMP,3 ; GET NEXT ARG C GETAR JMP FPRI4 ; END OF ARGS STA 0,TMP,3 ; SAVE ARG POINTER C GETSW ; GET ARGS SWITCHES LDA 0,TS.W AND# 0,2,SZR ; /T ? JMP FPLAS ; YES GO PROCESS LAST ADDRESS LDA 0,FS.W AND# 1,0,SZR ; /F ?? JMP FPFIR ; YES PROCESS FIRST ADDRESS LDA 0,LS.W AND# 0,1,SZR ; /L ?? JMP FPLIS ; YES PROCESS LISTING FILE JMP FPRI3 ; NONE OF THE ABOVE MUST BE ARG TO PRINT FPFIR: MOVZ 0,0,SKP ; MARK PATH FPLAS: MOVO 0,0 LDA 0,TMP,3 ; GET ARG POINTER C .ASCB ; CONVERT TO BINARY JMP @FOPER ; SORRY MOV 0,0,SZC ; WHICH WAY ?? STA 1,LAST,3 ; OH MOV 0,0,SNC STA 1,FIRST,3 JMP FPRIK ; WIPE POUT THIS ARG FPLIS: LDA 0,TMP,3 ; STORE ARG POINTER AS LISTING FILE STA 0,LIST,3 FPRIK: LDA 1,FIGNO ; WIPE OUT THIS ARG C SETSW JMP FPRI3 ; CONTINUE FIGNO: 3B7+1 TS.W: T.SW FS.W: F.SW STAID: STATI INCHN: ICH LCHAN: LCH K16: 16 K7: 7 LMASK: 177770 FPERAR: FPERF FOPER: FPER1 FPRI4: LDA 2,STAID ; SET UP FILE SYSTEM BUFFER ADD 3,2 STA 2,STAIP,3 LDA 0,INCHN ; PUT CHANNEL NUMBER IN STA 0,ICHAN,2 LDA 0,CP,3 ; GET FIRST FILE TO PRINT C GETAR JMP NOARG ; ERROR- NEED AT LEAST ONE ARGUMENT STA 0,CP,3 ; KGEEP AROUND IN CASE OF ERROR MOV 2,1 ; GET STATS ON FILE S RSTAT JMP @FOPER ; SORRY SUB 1,1 ; DON'T SUPPRESS ANYTHING C OPEN STATI  JMP @FOPER LDA 0,LIST,3 SUBZL 2,2 ; SET DEFAULT CHANNEL TO 1 MOV 0,0,SNR ; ANY FILE SPECIFIED ? JMP FPRI5 ; NO OقPEN DEFAULT SUB 1,1 ; SUPPRESS NOTHING MOV 0,2 ; COPY NAME TO SELF C MKFLA ; CREATE FILE IF NECESSARY JMP @FPERR S APPE LCH ; OPEN LISTING FILE JMP @FPERR ; GOOD GRIEF LDA 2,LCHAN ; GET LISTING CHANNEL NUMBER FPRI5: STA 2,LISCH,3 ; SAVE LISTING CtHANNEL BPT W0 OAERA ; FORM POINTER TO OUTPUT AREA BPT OLIN OLINP ; FORM POINTER TO OUTPUT LINE BPT RDIN RAERA ; FORM BYTE POINTER TO READ IN AREA CLER SKPLF FLIP ; CLEAR FLAGS SUB 0,0 SNZ ZSW ; /Z ? LDA 0,K16 ; NO START AT LOC 16 STA 0,CFPOS,3 ; ScAVE AS CURRENT FILE POSITION LDA 1,FIRST,3 ; A FIRST LOC SPECIFIED ? SNEZ 1 ; WELL ? LDA 1,CFPOS,3 ; NO USE CURRENT FILE POSITION STA 1,LOC,3 SUBZ 0,1,SNC ; LEGAL ADDRESS ? JMP FPFPE ; NO TRIED TO START BEFORE START SNEZ 1 ; WHERE WE WANT TO B9;E ?? JMP FPOU1 ; YES GO PROCESS MOV 1,2 ; NO- SAVE # WORDS TO DESIRED START LDA 0,OAERA,3 ; POINTER TO BUFFER AREA FPSK1: LDA 1,C10 ; AC1 <= 10 SUBZ 1,2,SNC ; LESS THAN 10 WORDS AWAY? JMP FPSK2 ; YES- GO READ REMAINING WORDS MOVZL 1,1 ; NO- 10 WOR DS = 20 BYTES C RDS STATI ; READ 20 BYTES JMP @.FPER1 ; TOO LITTLE, TOO SOON! JMP FPSK1 ; OK- TRY AGAIN FPSK2: ADD 2,1 ; # WORDS REMAINING MOVZL 1,1 ; NEED BYTE COUNT C RDS STATI ; READ BYTES REMAINING JMP @.FPER1 ; GOOD GRIEF! FPOU1: LDA 1,LOC,3 ; MUST BE MOD 8 LDA 0,K7 AND 1,0 ; IS IT ? STA 0,TMP1,3 ; SAVE OFFSET LDA 0,LMASK ; MAKE LOC MOD 8 AND 0,1 STA 1,LOC,3 LDA 2,TABL,3 ; BUILD OUTPUT LINE LDA 0,TMP1,3 LDA 1,C10 ; CALCULATE WORD COUNT FOR THIS LINE SUB 0,1 STA 1,WDCNT,3 LDA 1,OL(uINP,3 LDA 0,FLOC,2 ; MOVE LOC FORMAT IN C MOVE LDA 0,TMP1,3 SNEZ 0 ; DONE WITH SKIPS ? JMP FBOL2 ; YES NOW DO REAL STUFF FBLO1: LDA 0,FIGN,2 ; PICK UP DUMMY ENTRY C MOVE ; MOVE IT IN DSZ TMP1,3 ; DONE ? JMP FBLO1 ; NO CONTINUE JMP FBOL2 ; HAN0DLE USER INPUT ERRORS FPFPE: LDA 2,FPERP ; PHASE ERROR JMP @.FPER1 ; TAKE ERROR EXIT NOARG: LDA 2,NORG ; NOT ENOUGH ARGUMENTS JMP @.FPER1 ; TAKE ERROR EXIT C10: 10 FPERP: CPHER .FPER1: FPER1 NORG: CNEAR .FPNEX: FPNEX FBOL2: LDA 0,WDCNT,3 ; AC0 = NUM&BER OF REAL WORDS TO OUTPUT STA 0,TMP1,3 FBOL3: LDA 0,FNOR,2 C MOVE ; MOVE IN REAL ENTRIES DSZ TMP1,3 ; DONE ?? JMP FBOL3 ; NO MOVE IT AGAIN LDA 0,FEND,2 ; MOVE IN FINAL SEGMENT C MOVE LDA 2,RAERA,3 ; CLEAR READ AREA LDA 1,C10 ; AC1 <= # ENTRIES/LINE MOVZR 2,2 LDA 0,FLIP,3 ; GET FLIP-FLOP MOVZR 0,0,SZC ; WHICH HALF WE USING ? ADD 1,2 ; SECOND HALF NEG 1,1 STA 2,RDOFF,3 ; SAVE ADDRESS SUB 0,0 FBCL1: STA 0,0,2 ; CLEAR THE AREA INC 2,2 INC 1,1,SZR ; DONE ? JMP FBCL1 ; NO DO ANOTHER LDA 0,RDOFF,3 ; READ THE LINE LDA 1,C10 ADD 1,0 ; AC0 => NEXT LINE AREA LDA 1,WDCNT,3 ; SKIP IF NOT ON BOUNDARY -HW SUB 1,0 ; AC0 <= WORD ADDRESS OF READ AREA MOVZL 0,0 ; AC0 <= BYTE ADDRESS MOVZL 1,1 ; AC1 <= # BYTES TO READ C RDS STATI ; READ THE DCATA JMP FBERR LDA 1,FLIP,3 ISZ FLIP,3 ; INVERT FLIP-FLOP STATE NOP SNEZ 1 ; FIRST TIME ? JMP FBCNM ; YES CAN'T POSSIBLY MATCH LDA 2,RAERA,3 MOVZR 2,2 LDA 1,C10 STA 1,TMP1,3 ; SET COUNT FBCL2: LDA 0,0,2 ; COMPARE TWO WORDS LDA 1,10,2 SUB# 1,0O,SZR ; MATCH ?? JMP FBCNM ; NO PRINT LINE INC 2,2 DSZ TMP1,3 JMP FBCL2 LDA 0,SKPLF,3 ; ALL WORDS MATCHED !!! SEQZ 0 ; FIRST MATCHING LINE ?? JMP @.FPNEX ; NO JUST GET NEXT LINE ISZ SKPLF,3 ; YES COUNT THIS ONE LDA 0,SKIPL ; WRITE OUT SKIPp INDICATOR LDA 1,LISCH,3 C WRLCH JMP @.FPNEX ; GET NEXT LINE FBCNM: CLER SKPLF ; CLEAR SKIP FLAG JMP @OUTRN,3 ; GO TO PROPER ROUTINE ; HANDLE ERROR ON FILE READ FBERR: LDA 0,.EREOF ; AC0 <= EOF CODE SEQ 0,2 ; EOF ? JMP @.FPER1 ; NO- REPORT ERRORb ISZ FPEFG,3 ; YES- MARK IT INCZR 1,1,SNR ; ANYTHING COME IN ?? JMP @.FPEND ; NO- CLOSE UP SHOP STA 1,TMP,3 ; YES- SAVE PARTIAL READ COUNT LDA 1,WDCNT,3 ; AC1 <= # WORDS REQUESTED LDA 0,C10 ; AC0 <= # WORDS ON FULL LINE SUB 1,0,SNR ; FULL LINE REQUEBiST ? JMP FBER0 ; YES- TAKE USUAL PATH STA 0,WDCNT,3 ; NO- SAVE NUMBER OF DUMMY ENTRIES LDA 1,TMP,3 ; AC1 <= PARTIAL READ COUNT ADD 0,1 ; AC1 <= DUMMY + NORMAL LDA 0,C10 ; AC0 <= # ENTRIES/LINE SUB 1,0 ; AC0 <= # DUMMY ENTRIES FOR END OF LINE STA 0r,TMP1,3 ; PUT IN A SAFE PLACE FOR LATER LDA 2,TABL,3 ; NOW BUILD OUTPUT LINE LDA 1,OLINP,3 ; AC1 => OUTPUT LINE SPACE LDA 0,FLOC,2 ; AC0 => LOCATION COUNTER FORMAT C MOVE ; MOVE IT IN LDA 0,FIGN,2 ; AC0 => DUMMY ENTRY FBSPL: C MOVE ; MOVE IT IN DSZ WDCNT,3 ; DONE ? JMP FBSPL ; NO- KEEP MOVING LDA 0,TMP,3 ; AC0 <= # REAL ENTRIES STA 0,WDCNT,3 ; SET UP TO MOVE IN JMP FBNOR ; GO MOVE IN NORMAL ENTRIES FBER0: LDA 1,TMP,3 ; AC1 <= PARTIAL READ COUNT STA 1,WDCNT,3 ; SAVE IT LDA 2,TABL,3 ; BUILD FOR}MAT LINE LDA 0,C10 SUB 1,0 ; GET NUMBER TO SKIP STA 0,TMP1,3 LDA 1,OLINP,3 ; BUILD FORMAT LINE LDA 0,FLOC,2 ; LOCATION COUNTER C MOVE FBNOR: LDA 0,FNOR,2 ; NORMAL WORDS FBER1: C MOVE ; MOVE ONE IN DSZ WDCNT,3 ; ENOUGH ? JMP FBER1 ; NO MOVE ANOT9HER LDA 0,TMP1,3 ; IF NONE SNEZ 0 ; LEFT TO DO THEN JMP FBERX ; DONE ELSE LDA 0,FIGN,2 ; MOVE IN SKIP WORDS FBER2: C MOVE DSZ TMP1,3 ; ENOUGH OF EN JMP FBER2 ; NO KEEP ON MOVING FBERX: LDA 0,FEND,2 ; MOVE IN END OF LINE C MOVE JMP @OUTRN,3 ; PRI0NT LAST LINE K40: 40 .EREOF: EREOF SKIPL: SKPL*2 .FPEND: FPEND ; SET UP FULL WORD FORMAT WITH ASCII FOU1: LDA 0,RDOFF,3 ; GET POINTER TO DATA JUST READ LDA 1,OAERA,3 MOVZL 0,0 LDA 2,C20 ; TWENTY BYTES C CMOVE ; MOVE TO OUTPUT AREA LDA 0,OLINP,3 ;qd WRITE OUT NUMERIC PORTION OF LINE LDA 1,LISCH,3 C WRLCH LOC W0 W1 W2 W3 W4 W5 W6 W7 LDA 0,C20 STA 0,TMP1,3 ; SET LOOP COUNTER LDA 0,OAERA,3 ; NOW DO ASCII PORTION FOU1A: C LDBT ; GET FIRST BYTE TO PRINT LDA 2,K177 ; MASK TO SEVEN BITS AND 2,1 LDA 2,K40 ; TEST FOR PRINTABLE ASCII LDA 3,KLOWZ ; ALLOW LOWERCASE ASCII SUBZ# 2,1,SZC ; PRINTABLE SUBZ# 3,1,SZC ; WELL ? LDA 1,K56 ; NO MAKE IT "." C STBI ; STORE IT BACK DSZ TMP1,3 ; DONE ALL 8 ? JMP FOU1A ; NO CONTINUE SUB 1,1 ; YES STORE A NULL C STBI LDA 0,ASCLI ; WRITE IT OUT LDA 1,LISCH,3 C WRLCH OAERA JMP FPNEX ; GET NEXT LINE ; SET UP BYTE FORMAT WITH NO ASCII FOU2: LDA 2,KM20 STA 2,TMP1,3 ; SET COUNTER LDA 2,OAERA,3 MOVZR 2,2 LDA 0,RDOFF,3 MOVZL 0,0 STA 0,TMP,3 FOU21: LOADB TMP ; GET A BYTE STA 1,0,2 ; STORE IT INC 2,2 ISZ TMP1,3 ; DONE ?? JMP FOU21 ; NO DO ANOTHER BYTE LDA 0,OLINP,3 ; GET FORMAT LINE LDA 1,LISCH,3 ; AND CHANNEL NUMBER C WRLCH LOC W0 W1 W2 W3 W4 W5 W6 W7 X0 X1 X2 X3 X4 X5 X6  X7 FPNEX: SKZ FPEFG ; END OF FILE SEEN ? JMP FPEND ; YES ALL DONE LDA 1,LOC,3 ; NO BUMP LOC LDA 2,K10 ADDZ 1,2,SZC ; AC2 <= LOCATION FOR NEXT LINE JMP FPEND ; OVERFLOW- GOT TO BE DONE!! STA 2,LOC,3 LDA 1,LAST,3 SUBZ# 2,1,SNC ; AT OR PAST LAST LOC ? JMP FPEHND ; YES QUIT JMP @.FPOU1 ; NO PROCESS NEXT LINE ; HANDLE ERRORS FPER1: LDA 0,CP,3 ; GET FILE NAME ER1 4 JMP FPEND ; RESET AND TRY NEXT FPFRR: LDA 2,SSOSP,3 ; TAKE ERROR RETURN DSZ SSRTN,2 FPEND: LDA 2,LISCH,3 MOVZR# 2,2,SNR ; LIST CHANNEL ? JMP FPF ; NO JUST CLOSE INPUT S CLOS CPU ; YES CLOSE IT NOP FPF: S CLOS ICH ; CLOSE INPUT CHANNEL NOP RTRN ; THATS IT FPERF: ER1 3 JMP FPFRR K56: ". KLOWZ: 172 ; LOWERCASE Z K177: 177 K10: 10 ASCLI: ASCFM*2 .FPOU1: FPOU1 KM20: -20 C20: 20 ; ; @OUTPUT FORMAT TABLES ; BYTTB: BYTLO*2 BYTML*2 BYTIG*2 ENDL*2 DECTB: LOCLI*2 DECML*2 HEXIG*2 K10*2 HEXTB: HEXLO*2 HEXML*2 HEXIG*2 K10*2 OCTTB: LOCLI*2 OCTML*2 IG1*2 K10*2 ; ; OUTPUT FORMATS AND OTHER BULKY STUFF ; ** .NOLOC 1 BYTLO: .TXT _/^O^B<6> / BYTML: .TXT / ^O^Z<3> ^O^Z<3> / BYTIG: .TXT /^I^I ---- / HEXLO: .TXT /^H^B<6>/ HEXML: .TXT / ^H^Z<4>/ HEXIG: .TXT /^I ----/ DECML: .TXT /^D^B<7>/ OCTML: .TXT / ^O^Z<6>/ IG1: .TXT /^I ---- / LOCLI: .TXT /^O^B<6>/ ENDL: .TXT /<15>/ ASCFM: .TXT / ^C<15>/ SKPL: .TXT /***<15>/ LPTN: .TXT /$LPT/ ** .NOLOC 0 ; ; ENTER FILE SYSTEM ; ; DEFINE THE STACK CHANT= 1 ; CHANNEL TABLE ADDRESS CHAN= CHANT+1 ; PHYSICAL CHANNEL NUMBER TMP= CHAN+1 ; TEMP FOR ALL KINDS OF THINGS TMP0= TMP+1 ; COPY OF &CALLERS AC0 TMP1= TMP0+1 ; COPY OF CALLERS AC1 STACK= TMP1 ; STACK LENGTH 0 EFSYS: LDA 3,SSOSP,2 ; PICK UP OLD STACK POINTER LDA 0,@SSRTN,3 ; GET "CHANNEL NUMBER" ISZ SSRTN,3 ; SET GOOD RETURN ISZ SSRTN,3 LDA 1,SSAC0,3 ; COPY AC0 AND AC1 STA 1,TMeP0,2 LDA 1,SSAC1,3 STA 1,TMP1,2 ADDZ 0,3 ; FORM POINTER TO TABLE STA 3,CHANT,2 ; STASH IT LDA 0,ICHAN,3 ; COPY CHANNEL NUMBER STA 0,CHAN,2 STA 3,SSAC2,2 ; RETURN TABLE POINTER RTRN ; ; READ ROUTINES ; STACK RDS: C EFSYS ; DO SETUP RDS1: LDA 2 T,CHANT,3 ; POINT TO TABLE LDA 0,ICOUN,2 ; GET COUNT REMAINING SUBZ 1,0,SNC ; HAVE ENOUGH FOR THIS REQUEST ? JMP RDSPA ; NO GET SOME MORE STA 1,TMP,3 ; YES SAVE REQUESTED COUNT STA 0,ICOUN,2 ; SAVE UPDATED COUNT LDA 0,IPOIN,2 ; FROM POINTER ADD O"0,1 ; UPDATE FOR NEXT REQUEST STA 1,IPOIN,2 LDA 2,TMP,3 ; COUNT LDA 1,TMP0,3 ; TO POINTER C CMOVE ; MOVE DATA RTRN ; THATS ALL RDSPA: NEG 0,0 ; AC0 = # WORDS RENAMINIG STA 0,TMP,3 ; SAVE IT LDA 1,TMP0,3 ; UPDATE ADDRESS LDA 0,ICOUN,2 ADD 1,0  NAME LDA 1,BUFP,3 S LINK ; LINK IT JMP LOLER ; GOOD GRIEF LOLVF: SNZ VERIF ; VERIFY ?? JMP LLOOP ; NO GET NEXT BLOCK LDA 0,LOLV1 ; GET LONG VERIFY MESSAGE SKZ BSW ; /B ?? LDA 0,LOLV2 ; YES GET SHORT MESSAGE C TLEVL ; ADJUST FOR LEVEL WRVER VERIF ; WRITE IT OUT RNAMP BUFP JMP LLOOP ; GET NEXT BLOCK LOLER: LDA 1,.ERCRE SUB# 1,2,SZR ; FILE ALREADY EXISTS ?? JMP @LONFR ;  NO GIVE ERROR SNZ OSW ; OVERRIDE SWITCH ?? JMP LOLE1 ; NO TEST FOR /R C DELE ; YES GET RID OF IT JMP @LONFR ; CANT GET RID OF IT GIVE ERROR JMP LOLI2 ; TYPE TO CREATE IT AGAIN LOLE1: SNZ RSW ; /R ? JMP @LONFR ; NO GIVE ERROR JMP LLOOP ; q YES ALL OK LONFR: LONFN ; PROCESS A DATE/TIME BLOCK LOTIM: LDA 1,K6 ; 6 BYTES LDA 0,TBUFD ; INTO TIME BUFFER ADDZL 3,0 S RDS ICH ; READ IT JMP @LOFIE ; FATAL INPUT ERROR JMP LLOOP ; GET NEXT BLOCK TBUFD: STATO+UFTAC ; PROCESS AN ILLEGAL BLOCK TYnPE LOBAD: LDA 2,ILBT ; SEND ILLEGAL BLOCK TYPE MESSAGE LDA 0,IP,3 ; SHOW NAME JMP @LOFIE ; GIVE UP ILBT: CILBK LOFIE: INPER ; FATAL INPUT ERROR ; PROCESS A DUMMY BLOCK LODUM: LDA 0,TMPP,3 ; A PLACE TO READ THIS STUFF IN LDA 1,K2 S RDS ICH ; READ tTHE "ATTRIBUTES" JMP @LOFIE ; WELL LDA 2,TMP,3 COM# 2,2,SZR ; -1 ? JMP LOBAD ; NOT -1 AN ILLEGAL BLOCK TYPE ISZ SEGNO,3 ; BUMP SEGMENT NUMBER S RDS ICH ; GET SEGMENT # JMP @LOFIE LDA 2,TMP,3 ; GET JUST READ NUMBER LDA 0,BUFP,3 ; READ THE NAME S RDL ICH JMP @LOFIE LDA 1,SEGNO,3 ; EXPECTED SEGMENT NUMBER MOVZR 1,1,SZC ; EOT ? JMP LODET ; YES GO PROCESS STA 1,KSW,3 ; NO SAVE SEGMENT NUMBER IN CASE OF ERROR SUB# 1,2,SZR ; CORRECT NUMBER ?? JMP LODMB ; NO TELL THE DUMMY LDA 1,RNAMP,3 ; C` COMP ; CORRECT NAME ?? JMP @.DULOP ; YES GET NEXT BLOCK MOVZR 2,2,SNR ; FIRST TAPE MAYBE ?? JMP @.DULOP ; YES ALL IS WELL LODMB: LDA 0,DUMES C WRLIN KSW ; TELL THE DUMMY WHAT HE DID DSZ SEGNO,3 ; LIKE IT NEVER HAPPENED LODET: S CLOS ICH ; CLOS* LOVF1: .TXT * ^C^T<25>L ^C<15>* LOVF2: .TXT * ^C^I<15>* NVER1: .TXT * ^C^T<30>^D^Z<2>/^D^Z<2>/^D^Z<2><15>* NVER2: .TXT * ^C^I^I^I<15>* DIV1: .TXT * ^W^C.DR<15>* DUMDUM: .TXT *TAPE SEQUENCE ERROR: MOUNT TAPE# ^D^Z<2><15>* ** .NOLOC 0 ; CMPNM ; ROUTI|NE TO COMPARE SYSTEM NAME WITH A USER NAME. ; AC1 POINTS TO THE SYSTEM NAME ; AC0 POINTS TO THE USER NAME ; * WILL MATCH ANY SINGLE CHARACTER ; -(MINUS SIGN) WILL MATCH ANY NUMBER ; (INCLUDING 0) OF CHARACTERS ; CALL ; CMPNM ; - NO MATCH RETURN ; - MATCH$2 RETURN SPNT =1 ; HOLDS POINTER TO SYSTEM NAME UPNT =SPNT+1 ; POINTER TO USER NAME SCNT =UPNT+1 ; # OF CHAR LEFT IN SYSTEM NAME UCNT =SCNT+1 ; # LEFT IN USER NAME TO PROCESS STXSX =UCNT ; STACK SIZE NEEDED FOR UNMSCN ROUTINE SEXT =UCNT+1 ; POINTS TO SYSTEM NAME EXTENSION STYSZ =SEXT ; STACK SIZE NEED FOR CMPNM ROUTINE STYSZ ; COMPARE SYSTEN NAME ROUTINE START ADDRESS ; ALL REGS ARE SAVED ON STACK ON ENTRY ; SAVE START ADDRESS OF NAMES FOR PROCESSING CMPNM: STA 0,UPNT,3 ; SAVE START OF USER NAME STA 1,SPNT,3 ; AND SYSTEM NAME TO MATCH LDA 0,C12 ; GET MAX SIZE OF NAME ADD 0,1 ; CALC ADDRESS OF SYSTEM NAME EXTENXION STA 1,SEXT,3 ; AND SAVE IT ; SET IN THE MAX # OF CHARS ALLOWED IN SYSTEM AND USER NAMES STA 0,UCNT,3 ; SET THAT 12 IS HIGHEST STA 0,SCNT,3 ; ALLOWED ; SEE IF THE NAME MATCHES C NMSCN ; GO SCAN THE NAME RTRN ; IF NO MATCH THEN TELL OUR CALLER ELSE ; HAD A MATCH, CHECK IF USER NAME IS ALL DONE(IE ENDED IN ZERO BYTE) L1: LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE MATCH ENDETbD C LDBT ; GET CHAR MOV# 1,1,SNR ; IF IS ZERO THEN USER NAME IS DONE JMP L2 ; GO MAKE SURE SYSTEM NAME DOES NOT ; HAVE EXTENSION ISZ UPNT,3 ; INC TO NEXT CHAR POSITION IN USER NAME LDA 0,PER ; CHECK FOR PERIOD IN USER NAME INDICATING SUB# 0l,1,SZR ; AN EXTENSION IS PRESENT, IF NOT THEN JMP L1 ; LOOP TO LOOK MORE AT STRING ELSE ; SET UP TO MATCH THE NAME EXTENSIONS LDA 0,SEXT,3 ; GET ADDRESS OF SYSTEM NAME EXTENSION STA 0,SPNT,3 ; AND SET TO SCAN LDA 0,C2 ; SET MAX SIZE OF EXTENSION STaA 0,SCNT,3 ; TO BE 2 FOR USER AND SYSTEN STA 0,UCNT,3 ; NAMES ; SCAN THE EXTENSION FOR CORRECTNESS C NMSCN ; SCAN THE EXTENSION RTRN ; GIVE UP ON NO MATCH ELSE JMP L3 ; WE HAVE NAMES THAT MATCH ; USER NAME HAS NO EXTENSION, CHECK IF SYSTEN NAME# HAS EXTENSION L2: LDA 0,SEXT,3 ; GET ADDR OF EXTENSION C LDBT ; GET 1ST CHAR OF IT MOV# 1,1,SZR ; IF HAS EXTENSION THEN RTRN ; NO MATCH ELSE ; WE HAVE A NAME MATCH, RETURN TO CALLER AT MATCH ADDRESS L3: LDA 2,SSOSP,3 ; GET CALLER STACK POINTER ISZ SSRTN,2 ; INC RETURN POINTER TO MATCH ADDR RTRN ; RETURN TO CALLER PER: ". ; PERIOD SEPARATING FILE NAME FROM EXTENASION DASH: "- ; ANY LENGTH MATCH CHAR STAR: "* ; ANY CHAR MATCH C12: 12 ; # OF CHARS IN FILE NAMES C2: 2 ; # OF CHARS IN FILE NAME EX>TENSIONS ; INTERNAME ROUTINE FOR "CMPNM" TO TRY FOR MATCH OF WHAT IS LEFT ; OF STRING. ON ENTRY AC2 POINTS TO THE STACK OF THE CALLER ; WHICH CONTAINS WHERE THE CALLER WAS IN COMPARING THE 2 STRINGS. ; THIS ROUTINE STARTS AT WHERE THE CALLER LEFT OFF AN4D SCANS THE LINE ; IF NO MATCH THEN RETURNS TO CALLER AT CALL+1 WITH NOTHING CHANGED. ; IF MATCH THEN UPDATES THE USER POINTER IN THE CALLERS STACK TO ; POINT TO THE CHAR THAT ENDED THE COMPARE AND RETURNS AT CALL+2. ; IF ROUTINE ENCOUNTERS DASH THEN IT CALLS ITSELF WITH THE USER NAME ; POINTER POINTING TO THE CHAR AFTER THE DASH. IF ON RETURN IT HAS A ; MATCH THEN IT RETURNS TO ITS CALLER WITH A MATCH. IF NO MATCH THEN ; INCREMENTS THE SYSTEM NAME POINTER BY ONE AND CALLS ITSELF AGAIN. ; PROCESS CONTINUESg TILL EITHER MATCH OR SYSTEM FILE NAME ; EXHAUSTED. STXSX ; ROUTINE STACK SIZE NMSCN: ; ROUTINE START ADDRESS ; COPY WHERE CALLER WAS AT IN SCAN TO OWN STACK LDA 0,SPNT,2 ; GET WHERE WAS AT IN SYSTEM NAME STA 0,SPNT,3 ; SAVE IN OWN STACK LDA 0,UPN>T,2 ; GET WHERE AT IN USER NAME STA 0,UPNT,3 ; AND STORE LDA 0,SCNT,2 ; GET # CHARS MAX LEFT IN SYSTEM NAME STA 0,SCNT,3 ; AND STORE IT LDA 0,UCNT,2 ; SAME WITH USER NAME STA 0,UCNT,3 ; GET CHAR FROM EACH STRING TO MATCH NM1: LDA 0,UPNT,3 ; PICK UP CHAR FROM C LDBT ; USER STRING MOV 1,2 ; AND SAVE IN AC2 SUB 1,1 ; SET SYSTEM CHAR TO NULL AND LDA 0,SCNT,3 ; IF END OF SYSTEM STRING MOV# 0,0,SNR ; REACHED CHECK TO SEE JMP NM15 ; IF USER CHAR WAS NULL LDA 0,SPNT,3 ; ELSE PICK UP CHAR C LDBT ; FROM SYSTEM STRING ; CHECK TO SEE IF THEY ARE EQUAL NM15: SUB# 1,2,SZR ; IF NOT EQUAL THEN JMP NM3 ; BRANCH ELSE ; WE HAVE MATCH, SEE IF MATCH IS THAT OF END OF STRINGS MOV# 2,2,SNR ; IF WE ARE AT END OF STRINGS THEN JMP NM5 ; NAMES MATCH ELS^E ; NAMES NOT ALL MATCHED YET, CHECK TO SEE IF HAVE REACHED END OF ; WHAT SHOULD BE PROCESSED IN NAMES NM2: ISZ UPNT,3 ; UPDATE NAME POINTERS TO ISZ SPNT,3 ; NEXT CHAR DSZ SCNT,3 ; COUNT SYSTEM NAME CHAR NOP  DSZ UCNT,3 ; IF HAVE NOT MATCHED MAX # USER JMP NM1 ; CHARS THAN GET NEXT CHAR ELSE JMP NM5 ; WE HAVE COMPLETE MATCH ; CHARS DID NOT MATCH, CHECK FOR SPECIAL CHARS NM3: LDA 0,PER ; IF USER NAME CHAR IS A SUB# 0,2,SNR ; PERIOD THEN IS END OF USER JMP NM4 ; USER NAME SO BRANCH ELSE LDA _0,DASH ; IF IS DASH THEN GO SUB# 0,2,SNR ; WHAT PART OF REST OF SYSTEM NAME JMP NM9 ; MATCH USER NAME ELSE LDA 0,STAR ; IF IS STAR AND THE SYSTEM SUB# 0,2,SNR ; NAME CHAR IS NOT A ZERO THEN MOV# 1,1,SNR ; SAY THE CHARS MATCH ELSE RTRN ; RETUR"N WITH NO MATCH JMP NM2 ; FOUND PERIOD IN USER NAME, CHECK THAT SYSTEM NAME IS ENDED NM4: MOV# 1,1,SZR ; IF SYSTEM NAME DID NOT END AT RTRN ; SAME POINT AS USER THEN NO MATCH ELSE ; NAMES DO MATCH, RETURN ADDRESS OF WHERE MATCH ENDED IN USER NAME ; TTO CALLER. NM5: LDA 2,SSOSP,3 ; GET ADDRESS OF CALLER STACK LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE ENDED STA 0,UPNT,2 ; RETURN TO CALLER ; INC RETURN ADDR TO SUCCESSFUL RETURN ADRESS AND DONE ISZ SSRTN,2 RTRN ; FOUND DASH IN USER NAME, INC PAST! THE DASH NM9: ISZ UPNT,3 ; CHECK, IF DASH WAS LAST CHAR OF NAME THEN WE HAVE A MATCH LDA 0,UPNT,3 ; GET POINTER TO USER NAME C LDBT ; GET NEXT CHAR OF NAME LDA 0,PER ; IF IT IS ENDED THEN SUB# 0,1,SZR ; WE HAVE A MATCH ELSE MOV# 1,1,SNR ; WE HAVE NO MATCH JMP NM5 ; MATCH ; SEE IF WHAT IS LEFT OF USER NAME MATCHES WHATS LEFT OF SYSTEM NAME NM10: C NMSCN ; SCAN NAMES FOR MATCH MOV# 1,1,SKP ; IF NO MATCH THEN SKIP ELSE JMP NM5 ; IF MATCH THEN WOOPY, GO RETURN SUCCESS ; DOES NOT MATCH, SEE IF ANYTHING LEFT OF SYSTEM NAME TO TRY MATCH ISZ SPNT,3 ; INC SYSTEM NAME POINTER TO NEXT CHAR DSZ SCNT,3 ; IF STILL SOMETING LEFT OF NAME THEN MOV# 0,0,SKP ; SKIP ELSE RTRN ; RETURN WITH NO MATCH ; NOT PAST MAX # OF CHARS IN SYSTEM NAME, STILL CHECK FOR NAME END LDA 0,SPNT,3 ; GET POINTER TO SYSTEM NAME C LDBT ; GET CHAR FROM IT MOV# 1,1,SNR ; IF IS END OF SYSTEM NAME THEN RTRN ; NO MATCH POSSIBLE ELSE JMP NM10 ; GO SEE IF MATCH ; ; ENTER FILE SYSTEM ; ; DEFINE THE STACK CHANT= 1 ; C8HANNEL TABLE ADDRESS CHAN= CHANT+1 ; PHYSICAL CHANNEL NUMBER TMP= CHAN+1 ; TEMP FOR ALL KINDS OF THINGS TMP0= TMP+1 ; COPY OF CALLERS AC0 TMP1= TMP0+1 ; COPY OF CALLERS AC1 STACK= TMP1 ; STACK LENGTH 0 EFSYS: LDA 3,SSOSP,2 ; PICK UP OLD STACK POINTPER LDA 0,@SSRTN,3 ; GET "CHANNEL NUMBER" ISZ SSRTN,3 ; SET GOOD RETURN ISZ SSRTN,3 LDA 1,SSAC0,3 ; COPY AC0 AND AC1 STA 1,TMP0,2 LDA 1,SSAC1,3 STA 1,TMP1,2 ADDZ 0,3 ; FORM POINTER TO TABLE STA 3,CHANT,2 ; STASH IT LDA 0,ICHAN,3 ; COPY CHANNEL NUMEBER STA 0,CHAN,2 STA 3,SSAC2,2 ; RETURN TABLE POINTER RTRN STACK WRS: C EFSYS ; DO SETUP STUFF WRS1: LDA 3,CHANT,3 ; POINT TO CHANNEL TABLE LDA 2,IFLAG,3 ; SET FLAG TO WRITE MOVZL 2,2 MOVOR 2,2 STA 2,IFLAG,3 LDA 2,ICOUN,3 ; GET COUNT LDA 0,ISICZE,3 ; YES GET FULL COUNT SUB 2,0 ; FORM COUNT REMAINING SUBZ 1,0,SNC ; ENOUGH ROOM FOR THIS WRITE ? JMP WRSPA ; NO DO PARTIAL ADD 1,2 STA 2,ICOUN,3 ; RESTORE COUNT MOV 1,0 LDA 1,IPOIN,3 ; UPDATE POINTER ADD 1,0 STA 0,IPOIN,3 LDA 3,USP ; RESTORE STACK POINTER LDA 2,TMP1,3 ; COUNT LDA 0,TMP0,3 ; FROM POINTER C CMOVE ; MOVE THE DATA RTRN WRSPA: MOV 3,2 LDA 3,USP ; RESTORE STACK POINTER ADD 1,0 STA 0,ICOUN,2 ; SAVE COUNT TO MOVE SUBZ 0,1 ; AC1 = REQUEST OUTSTANDING STA 1,TMP1,3 ; SAVE IT 1j LDA 1,TMP0,3 ; UPDATE INPUT BYTE POINTER ADD 1,0 STA 0,TMP0,3 MOV 1,0 LDA 1,IPOIN,2 LDA 2,ICOUN,2 C CMOVE ; MOVE WHAT WE HAVE LDA 2,CHANT,3 ; FLUSH OUT BUFFER LDA 1,ISIZE,2 ; FORCE FULL BLOCK WRITE STA 1,ICOUN,2 LDA 2,IWRIT,2 RCALL JMP WRSER ; ERROR RETURN LDA 1,TMP1,3 ; RESTORE COUNT REMAINING JMP WRS1 ; GO TO IT WRSER: LDA 3,SSOSP,3 ; RETURN ERROR CODE TO CALLER STA 2,SSAC2,3 DSZ SSRTN,3 RTRN RDSE1: LDA 3,SSOSP,3 ; AC3 <= CALLER'S STACK POINTER LDA 2,CHANT,3 STA 1,ICOUN,2 ; SET COUNT READ ISZ SSRTN,3 RTRN 0 WRSEQ: LDA 2,CHANT,2 ; POINT TO TBALE LDA 0,IBUFP,2 STA 0,IPOIN,2 ; RESET POINTER LDA 1,ICOUN,2 ; GET COUNT LDA 2,ICHAN,2 ; AND CHANNEL # S WRS CPU JMP RDRER SUB 1,1 ; RESET COUNT JMP RDSE1 RDRER: LDA 3,USP LDA 3,SSOSP,3 ; SET ERROR RETURN STA 2,SSAC2,3 RTRN K1000: 1000 K400: 400 K776: 776 0 WRRAN: LDA 3,CHANT,2 ; PICK UP TABLE POINTER LDA 1,IBUFP,3 MOVZR 1,0 STA 1,IPOIN,3 LDA 1,ICOUN,3 LDA 2,ISIZE,3 SEQ 2,1 ; FULL BLOCK ?? JMP WRRPA ; NO DO PARTIALd NEGOR 1,1 MOV 0,2 ; MAKE BUFFER ADDRESS ACCESSABLE WRRA1: LDA 0,0,2 ; TEST FOR FULL BLOCK OF ZER0S MOV 0,0,SZR ; WORD ZERO ? JMP WRRWR ; NO WRITE BLOCK OUT INC 2,2 INC 1,1,SZR ; DONE ?? JMP WRRA1 ; NO DO NEXT WORD ISZ IBLOC,3 ; YES ALL ZER0' - BUMP BLOCK NUMBER NOP ; WATCH FOR WRAP AROUND SUB 1,1 ; RESET COUNT LDA 3,USP ; EXIT WITHOUT WRITING BLOCK JMP @.RDS1 .RDS1: RDSE1 ; HANDLE BLOCK WRITES - ; BLOCKS CONTAINING ALL ZEROES ARE NOT WRITTEN OUT WRRWR: LDA 0,IPOIN,3 ; WRITE OUT BLOCK =n MOVZR 0,0 ; ADDRESS LDA 1,IBLOC,3 ; AC1 <= CURRENT BLOCK TO WRITE INC 1,2 ; AC2 <= NEXT BLOCK NUMBER STA 2,IBLOC,3 ; UPDATE CURRENT BLOCK # STA 2,ICBLK,3 ; AND LAST BLOCK WRITTEN LDA 2,ICHAN,3 ; AC2 <= CHANNEL NUMBER LDA 3,K400 ; FORM CHANNEL NUMBEHqR AND BLOCK COUNT ADD 3,2 S WRB CPU ; WRITE THE BLOCK JMP RDRER ; BAD NEWS SUB 1,1 JMP @.RDS1 ; RETURN WRRPA: LDA 1,IBLOC,3 ; A PARTIAL BLOCK TO WRITE STA 1,ICBLK,3 LDA 2,KM11 ; SHIFT COUNT SUB 0,0 WRPA1: MOVZL 1,1 ; DBL LENGTH SHIFT TO FORM BYTE ;WADDRESS MOVL 0,0 INC 2,2,SZR JMP WRPA1 LDA 2,ICHAN,3 ; GET CHANNEL NUMBER S SPOS CPU ; POSITION FILE TO THIS BLOCK IN CASE OF SKIPED BLOCKS JMP RDRER LDA 3,USP ; WRITE OUT WHAT IS LEFT BY WRS LDA 2,SSOSP,3 JMP @.WRSE .WRSE: WRSEQ KM11: -11 ; OPGdEN A FILE STACK OPEN: C EFSYS ; DO SETUP MAGIC SUB 1,1 STA 1,IBLOC,2 ; CLEAR BLOCK NUMBER STA 1,ICBLK,2 ; CLEAR LAST BLOCK WRITTEN STA 1,ICOUN,2 ; CLEAR COUNT STA 1,IFLAG,2 ; CLEAR FLAGS WORD LDA 1,IBUFD ; SET UP BUFFER POINTERS ADDZL 2,1 STA 1,&IBUFP,2 STA 1,IPOIN,2 LDA 1,UFTAT,2 ; GET ATTRIBUTES LDA 0,RANCON AND# 0,1,SZR ; RANDOM OR CONTIGUOUS ? JMP OPERN ; YES SET UP FOR BLOCK IO LDA 0,RSEQ ; SET UP FOR SEQUENTIAL STA 0,IREAD,2 LDA 0,WSEQ STA 0,IWRIT,2 LDA 0,K776 OPEN1: STA 0,ISIZE,q2 LDA 0,TMP0,3 ; DO ACTUAL OPEN LDA 1,UFTYD,2 ; DO WE HAVE A TIME ? MOV 1,1,SZR ; WELL JMP OPENT ; YES DO IT BY MAGIC LDA 1,TMP1,3 LDA 2,CHAN,3 S OPEN CPU JMP OPEER ; HELLO RTRN ; THATS IT OPENT: LDA 1,TMP1,3 LDA 2,CHAN,3 S TOPEN CPU JMP OP[EER RTRN IBUFD: IBUFF OPERN: LDA 0,RRAN ; SET UP FOR BLOCK IO STA 0,IREAD,2 LDA 0,WRAN STA 0,IWRIT,2 LDA 0,K1000 ; SET BLOCK SIZE IN BYTES JMP OPEN1 ; GO DO ACTUAL OPEN RSEQ: WSEQ: WRSEQ RRAN: WRAN: WRRAN RANCON: ATRAN+ATCON OPEER: LDA 3,SSOSP,3r DSZ SSRTN,3 STA 2,SSAC2,3 ; TAKE ERROR RETURN RTRN ; CLOSE FILE ROUTINE STACK CLOSN: C EFSYS ; SAVE THE WORLD SUBC 1,1 ; SET NO ATTRIBUTE FLAG JMP CLOS0 ; JOIN COMMON CODE STACK CLOS: C EFSYS ; DO SETUP ADC 1,1 ; CHANGE ATTRIBUTES FLAG CLOSS0: STA 1,TMP0,3 LDA 1,IFLAG,2 ; GET FLAG MOVZL# 1,1,SNC ; WRITING (1B0)? JMP CLOS2 ; NO JUST CLOSE FILE LDA 0,ICOUN,2 ; ANYTHING LEFT IN BUFFER ?? MOV 0,0,SZR ; WELL ?? JMP CLOS3 ; YES FLUSH IT OUT CLOS1: LDA 1,UFTAT,2 LDA 0,RANAT AND# 0,1,SN]R ; RANDOM FILE? JMP CLOSC ; NO - JUST CLOSE IT UP LDA 1,IBLOC,2 ; LAST BLOCK TO WRITE (+1) LDA 0,ICBLK,2 ; LAST BLOCK WRITTEN (+1) SUB# 0,1,SNR ; LAST BLOCK WRITTEN ? JMP CLOSC ; YES - JUST CLOSE FILE NEG 1,1 ; NO- GET NUMBER OF COM 1,1 ; LAST BLaVOCK TO WRITE. LDA 3,KM11 ; FORM DOUBLE PRECISION BYTE SUB 0,0 ; POINTER TO LAST BYTE IN LAST BLOCK. CLOSL: MOVOL 1,1 MOVL 0,0 ; DOUBLE LENGTH SHIFT INC 3,3,SZR ; DONE ? JMP CLOSL ; NO - KEEP LOOPING LDA 2,ICHAN,2 ; CHANNEL NUMBER S SPOS CPU ; POSI,TION TO LAST BYTE JMP OPEER LDA 0,BPTNL ; SET FILE SIZE BY WRITING A NULL BYTE SUBZL 1,1 ; TO LAST POSITION IN FILE WHICH MUST S WRS CPU ; BE IN A BLOCK CONTAINING ALL ZEROES. JMP OPEER CLOSC: SNZ TMP0 ; CHANGE ATTRIBUTES ? JMP CLOS2 ; NO CONTINUE QLDA 2,CHANT,3 ; CHANGE THE ATTRIBUTES LDA 0,UFTAT,2 LDA 2,CHAN,3 S CHATR CPU JMP OPEER LDA 2,CHANT,3 ; CHANGE THE LINK ATTRIBUTES LDA 0,UFTLK,2 LDA 2,CHAN,3 S CHLAT CPU JMP OPEER CLOS2: LDA 2,CHAN,3 ; CHANNEL NUMBER S CLOS CPU ; CLOSE FILE JMFlP OPEER RTRN ; AND RETURN. RANAT: ATRAN CLOS3: LDA 2,IWRIT,2 ; WRITE OUT LAST BLOCK RCALL JMP OPEER LDA 2,CHANT,3 JMP CLOS1 ; CONTINUE CLOSE BPTNL: .+1*2 0 ; ; CREATE FILE ROUTINE ; THIS ROUTINE CREATES A FILE,LINK,DIRECTORY OR PARTITION ; AdCCORDING TO THE UFT ENTRY POINTED TO BY AC2 ; ; CALLING SEQUENCE ; LDA 0,(FILENAME) ; LDA 2,(POINTER TO STATS) ; CALL ; CREATE ; (ERROR RETURN) ; AC2 = ERROR CODE ; (NORMAL RETURN) ; ; ; DEFINE THE STACK TMP= 1 ; TEMP FOR ALL KINDS OF THINGS NAME= TMP+1 ; ADDRESS OF FILE NAME LNAM= NAME+1 ; AREA FOR LINK NAME LNAMP= LNAM+20 ; POINTER TO LNAM STACK= LNAMP ; STACK SIZE STACK CREATE: ISZ SSRTN,2 ; ASSUME GOOD RETURN STA 0,NAME,3 LDA 2,SSAC2,2 ; GET POINTER TO STATS LDA 0,UFTAT,2 ; GET ATTRIBUTES LDA 1,CRTBL ; DISPATCH TO PROPER ROUTINE STA 1,TMP,3 CREA1: LDA 1,@TMP,3 ; GET A MASK ISZ TMP,3 COM# 1,1,SZR ; END OF TABLE AND# 1,0,SZR ; OR MATCH ? JMP CREA2 ; YES GO TO IT ISZ TMP,3 ; NO BUMP TO NEXT ENTRY JMP CREA1 ; GO TO IT CREA2: LDAP 1,@TMP,3 ; GET ROUTINE ADDRESS STA 1,TMP,3 ; MAKE IT ACCESSABLE JMP @TMP,3 ; GO TO IT CRTBL: .+1 ATPAR ; PARTITION CRPAR ATDIR ; DIRECTORY CRDIR ATRAN ; RANDOM CRRAN .ATCON: ATCON CRCON -1 CRSEQ ; CREATE A RANDOM FILE CRRAN: C CKNAM ; STEST NAME AND TIME BLOCK JMP CRRA1 ; NO TIME BLOCK DO REGULAR CREATE S TCRND ; HAS A TIME BLOCK DO MAGIC CREATE JMP CRERR RTRN CRRA1: S CRAN JMP CRERR RTRN ; CREATE A CONTIGUOUS FILE CRCON: C CKNAM ; TEST FOR TIME BLOCK JMP CRCO1 ; NO TIME BLO*RCK DO REGULAR CREATE S TCCON ; HAD A TIME BLOCK - MAGIC JMP CRERR RTRN CRCO1: S CCON JMP CRERR RTRN ; CREATE A SEQUENTIAL FILE CRSEQ: C CKNAM ; TEST FOR TIME BLOCK ETC JMP CRSE1 ; NO TIME BLOCK DO REGULAR CREATE S TCREA JMP CRERR RTRN CRSE1H[: S CREA ; PLAIN OL CREATE JMP CRERR RTRN ; CREATE A PARTITION CRPAR: C CKNAM ; DO SETUP STUFF NOP ; NO SUCH THING AS A TRANSPARANT CPAR S CPAR JMP CRERR ; GOOD GRIEF RTRN ; CREATE A DIRECTORY CRDIR: C CKNAM ; SETUP NOP S CDIR JMP CRERR & RTRN ; SETUP ROUTINE 0 CKNAM: MOV 2,3 ; SSOSP BECOMES CSP LDA 2,SSAC2,2 ; GET STATS POINTER LDA 1,UFTYD,2 ; GET FIRST WORD OF TIME BLOCK MOV 1,1,SZR ; ANY TIME ? ISZ SSRTN,3 ; YES BUMP RETURN LDA 1,.UFAC ; RETURN POINTER TO TIME BLOCK ADD 2,a1 STA 1,SSAC2,3 LDA 1,.ATCON AND# 1,0,SNR ; CONTIG ? JMP CKNA1 ; NO JUST GET NAME LDA 1,UFTBK,2 ; YES BLOCK LENGTH TO AC1 INC 1,1 STA 1,SSAC1,3 CKNA1: LDA 0,NAME,3 ; NAME TO AC0 STA 0,SSAC0,3 RTRN ; GO TO IT CRERR: LDA 3,SSOSP,3 ; RETURN ERRORW7 CODE STA 2,SSAC2,3 DSZ SSRTN,3 RTRN .UFAC: UFTAC TMP= 1 ; TEMP MONTH= TMP+1 ; MONTH/DAY/YEAR DAY= MONTH+1 YEAR= DAY+1 FEB= YEAR+1 ; FEBUARY DATE= FEB+1 ; ACCUMULATED DATE STACK= DATE ; STACK LENGTH STACK CNVRT: ISZ SSRTN,2 ; ASSUME GOOD RETURN LDA 2,CM3 ; THREE ARGS STA 2,TMP,3 ; SET COUNTER LDA 2,MONTD ; POINT TO MONTH ADD 3,2 CNVR0: C .ASCD ; CONVERT TO BINARY JMP NUMER ; SOME TYPE OF ERROR STA 1,0,2 ; SAVE VALUE INC 2,2 ; POINT TO NEXT ISZ TMP,3 ; DONE WITH THREE ? JMP CNVR1 @; NO CONTINUE JMP CNVR2 ; YES GO PROCESS CNVR1: LDA 1,CDASH ; POINT TO NEXT ARGUMENT C INDEX JMP NUMER ; TRY AGAIN INC 0,0 JMP CNVR0 ; NO CONVERT NEXT CNVR2: LDA 1,YEAR,3 ; YES GET YEAR LDA 0,K1968D ; TRY TO TAKE OUT 1968 SUBZ# 0,1,SNC ; COME OUT ?? LDA 0,K68D ; NO TRY 68 SUBZ 1,0,SEZ JMP NUMER ; BAD YEAR STA 0,YEAR,3 ; SAVE YEAR MOVZR 0,1,SNC ; A LEAP YEAR PERHAPS ? MOVR 1,1 LDA 2,K14 ; IF SO ADD DAY TO FEB MOVCL 2,2 STA 2,FEB,3 LDA 2,K12 LDA 1,MONTH,3 MOV 1,1,SZR SUBZ# 1,2,SNC ;< LEGAL MONTH ?? JMP NUMER ; NO PUNISH LDA 2,MTBL SUB 0,0 ; CLEAR RESULT WORD CNVR3: LDA 1,0,2 ; AC1= DAYS TO THIS MONTH COM# 1,1,SNR ; FEB PERHAPS ?? LDA 1,FEB,3 ; YES GET IT DSZ MONTH,3 ; DONE ? JMP CNVR4 ; NO ADD THIS MONTH JMP DAYS ; YES GO TO DAYS CNVR4: ADD 1,0 INC 2,2 ; BUMP POINTER JMP CNVR3 ; CONTINUE DAYS: LDA 2,DAY,3 ; GET DAYS SUBZ# 2,1,SNC ; DAYS LEGAL ? JMP NUMER ; SHAME ON YOU ADD 2,0 ; YES ADD THEM IN STA 0,DATE,3 ; SAVE DATE LDA 0,YEAR,3 ; GET YEAR YEAR1: MOVZ 0,0,SNR ; ;ZER0 ? JMP FINI ; YES ALL DONE INC 0,0 ; NO BUMP YEAR LDA 2,CM366 ; 365 DAYS PER LEAP YEAR MOVZR 0,1,SNC ; IS IT LEAP YEAR MOVR 1,1,SZC INC 2,2 ; NO MAKE IT 365 DAYS NEG 2,2 LDA 1,DATE,3 ADD 1,2 STA 2,DATE,3 JMP YEAR1 ; CONTINUE FINI: LDA 2,SSOSP,3 ; RETURN DATE TO CALLER LDA 1,DATE,3 STA 1,SSAC1,2 RTRN NUMER: LDA 3,SSOSP,3 DSZ SSRTN,3 LDA 0,SSAC0,3 ; AC0 => ARGUMENT LDA 2,.ERTIM ; TIME ERROR MESAGE ER1 3 ; GIVE ERROR MESSAGE RTRN ; ALL ERRORS ARE FATAL RTRN MTBL: .+1 31. -1 3 1. C30: 30. C31: 31. 30. 31. 31. 30. 31. 30. 31. CM3: -3 CDASH: "- MONTD: MONTH K1968D: 1968. K68D: 68. K14: 14. K12: 12. CM366: -366. .ERTIM: ERTIM ; ; CONVERT JULIAN DAY TO DAY/MONTH/YEAR ; 0 DAYCV: LDA 0,STATO+UFTYD,2 ; GET DAYS SINCE 1968 SUB 2,2,SKP ; BEGIN WITH YEAR 0 YRLP: INC 2,2 ; NEXT YEAR LDA 1,CM366 ; -(DAYS IN LEAP YEAR) MOVZR 2,3,SNC ; 1 IN B15? MOVR 3,3,SZC ; OR B14 INC 1,1 ; ONE OR BOTH SET - NOT LEAP YEAR ADDZ 1,0,SEZ ; SUBTRACT A YEAR OF DAYS JMP YRLP ; NOT THERE YET SUB 1,0 ; ONE OVER - RESTORE IT LDA 1,K68D ; BASE YEAR ADD 1,2 ; THIS YEAR LDA 3,USP LDA 3,SSOSP,3 ; STORE RESULTS IN CALLERS STACK STA 2,YR,3 ; STORE YEAR SUBZL 1,1 STA 1,MO,3 ; START WITH MONTH 1 LDA 1,C31 ; 31 DAYS HATH JANUARY SUBZ 1,0,SBN ;0 SKP IF DAYS > JAN. JMP GOTMO LDA 1,C28 ; FEBRUARY... COMZR 2,2,SZC ; CHECK BIT 15 - LEAP YEAR? MOVR 2,2 ; NOW BIT 14 - CARRY=0 NO, 1 YES LDA 2,MWRD ; WORD WITH BITS SET FOR 31 DAY MONTHS MOVR 2,2,SKP ; MOVE CARRY INTO FEB'S PLACE MOLP: LDA 1,C30 ; 3)0 DAYS HATH EVERYBODY ISZ MO,3 ; NEW MONTH MOVL 2,2,SZC ; UNLESS BIT SET INC 1,1 SUBZ 1,0,SEZ ; TAKE OFF THIS MONTHS DAYS JMP MOLP GOTMO: ADD 1,0 ; WENT PAST IT STA 0,DA,3 ; STORE DAY RTRN C28: 28. MWRD: 126500 ; 1010110101000000 MKNMS.SR5  ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMKNMS .RB CMKNMS.RB ** .ENDC J .TITL BMKNMS .RB BMKNMS.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT MKNMS .EXTN GETAsR ; GET ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN GETSP ; GET SWITCH POINTER .EXTN SETSW ; SET SWITCH ROUTINE .EXTN BFMVI ; BUFFER MOVE LINE .EXTN PCBUF ; PUT CHARACTER BUFFER .EXTN CNVRT ; CONVERT TIME INPUT .EXTN SBUFR ; SCRATCH BUFFER .EXTN LDBT STBT .EXTN LDBI STBI .EXTN CALL RTRN RCALL .EXTN WRBIN .EXTN CMOVE .EXTN .INDEX ; DEFINE THE STACK ASW= 1 ; ATTRIBUTES TO IGNORE OSW= ASW+1 ; ATTRIBUTES TO LOOK FOR IP= OSW+1 ; INPUT POINTER BPTR= IP+1 ; POINTER TO FILE TABLE ADATE= BPTR+1 ; [AFTER DATE BDATE= ADATE+1 ; BEFORE DATE NAMEP= BDATE+1 ; POINTER TO NAME BP= NAMEP+1 ; POINTER TO BUFF NAME= BP+1 ; SPACE FOR FILE NAMES BUFH= NAME+12 ; BUFFER HEADER ADDRESS BUFF= BUFH+2 ; BUFFER ADDRESS STACK= BUFF+401; STACK SIZE ** .DO CCOND cSYSCH= PUSCH ** .ENDC J SYSCH= TMPCH **[J] STACK MKNMS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN STA 0,IP,3 ; SAVE INPUT POINTER STA 1,ASW,3 ; SAVE ATTRIBUTES OFF WORD LDA 2,SSAC2,2 ; SAVE ATTRIBUTES ON WORD STA 2,OSW,3 ADC 1,1 STA 1,BDATE,3 ; BEFORE?f TIME = END OF TIME CLER ADATE ; AFTER DATE = 0 MKNM0: STA 1,BP,3 ; SET/RESET ARG FLAG MKNM1: C GETAR ; GET NEXT ARGUMENT JMP MKNP2 ; NONE LEFT GO TO NEXT PASS C GETSW ; GET SWITCHES MOVZL 1,2,SZC ; /A ? JMP AFTER ; YES PROCESS AFTER DATE MOVZL 2,2 ,SZC ; /B ? JMP BEFOR ; YES PROCESS BEFORE DATE LDA 1,MDASH C .INDEX ; A DASH IN NAME ? JMP MKNM2 ; NO TRY FOR STAR JMP MKNM0 ; YES IGNORE NAME MKNM2: LDA 1,MSTAR C .INDEX ; A STAR MAYBE ? JMP MKNM3 ; NO PUT NAME IN BUFFER JMP MKNM0 ; YES IhGNORE NAME MKNM3: LDA 1,K20 ; /N ?? AND 1,2,SZR JMP MKNM1 ; YES DON'T ADD TO LIST LDA 2,.SBUFR ; NO ADD NAME TO BUFFER C BFMVI ISZ BFFFB,2 ; COUNT NULL LDA 1,SWUS ; MARK ENTRY USED C SETSW LDA 1,KSWN ; NOW MAKE NAME A /N FOR SYS.DR SEARCH JMP MKNM5 MKNM4: LDA 1,KSWI ; KILL THIS ARG IN LIST MKNM5: C SETSW ; BY SETTING INVISABLE SWITCH JMP MKNM1 ; GET NEXT AFTER: C CNVRT ; CONVERT DAYS SICE 68 JMP FATER ; SOME TYPE OF ERROR STA 1,ADATE,3 JMP MKNM4 BEFOR: C CNVRT ; CONVERT TO DAYS SINCE 68 JMP FATER ; TRY AGAIN STA 1,BDATE,3 ; SAVE IT JMP MKNM4 ; CONTINUE MDASH: "- MSTAR: "* ; NOW PROCESS NORMAL ARGUMENTS MKNP2: SNZ BP ; ANY - OR * ARGS ?? JMP NOARL ; NO TAKE A SHORT CUT BPT NAME NAMEP ; MAKE POINTER TO NAME SPACE BPT BUFF BP ; AND BUFFER MOV 1,0 ; SET UP POINTERS LDA 1,.SYSCH C RDSIN ; OPEN UP SYS.DR JMP SYSER ; ;;;; FINI1: LDA 0,BP,3 ; GET FIRST ENTRY C RDSYS JMP REDER ; MAY BE END OF FILE LDA 0,ASW,3 ; CHECK FOR ATTRIBUTS MASK LDA 1,UFTAT,2 AND 1,0,SZR ; IF ANYM OF THEM ON SKIP THIS ENTRY JMP FINI1 LDA 0,OSW,3 ; TEST ATTRIBUTES ON WORD COM# 0,0,SNR ; ALL CASE ?? MOV 0,1 ; YES INSURE A MATCH AND 1,0,SNR ; AT LEASE ONE OF THEM ON ?? JMP FINI1 ; NO SKIP THIS FILE MOVZL 2,0 ; SET POINTER C CNAME ; NAME MATCGH ?? JMP FINI1 ; NO TRY NEXT LDA 0,UFTAT,2 LDA 1,.ATLNK AND# 1,0,SZR ; A LINK ?? JMP FIND2 ; YES - LINKS HAVE NO TIME LDA 0,UFTYD,2 LDA 1,ADATE,3 SUBZ# 1,0,SNC ; TOO OLD ? JMP FINI1 ; YES SKIP IT LDA 1,BDATE,3 SUBZ# 1,0,SZC ; TOO YOUNG ? JMP VFINI1 ; YES FORGET IT ALSO FIND2: LDA 0,NAMEP,3 C SNTUN LDA 2,.SBUFR C BFMVI ISZ BFFFB,2 ; COUNT FINAL NULL JMP FINI1 ; CONTINUE REDER: LDA 3,KEOF SUB# 3,2,SZR ; END OF FILE ?? JMP SYSER ; NO TOO BAD S CLOS SYSCH ; YES CLOS SYS.DR CHANNEL PLNOP NOARL: LDA 1,K200 ; STORE TERMINATOR LDA 2,.SBUFR C PCBUF SUB 1,1 ; STORE A NULL C PCBUF ENDEX: LDA 0,IP,3 ; RESTORE ARG POINTER ENDE1: C GETAR ; GET NEXT ARGUMENT RTRN ; ALL FINISHED C GETSW ; GET SWITCHES MOVZR 2,2 MOVZR 2,2,SZC ; USED ?? JMP ENDE1 ; YES GET NEXT LDA 2,.CSPER ; GIVE ERROR ER1 4 JMP ENDE1 ; CONTINUE JMP FATER ; SORRY ABOUT THAT KSWN: 1B7+N.SW ; SWITCH WORD ONE BIT 13 KSWI: 3B7+1 ; SWITCH WORD TWO BIT 15 K20: 20 K200: 200 .ATLNK: ATLNK .SYSCH: SYSCH .SBUFR: SBUFR Kt EOF: EREOF .CSPER: CSPER MSSYS: DIRN*2 SWUS: 3B7+2 SYSER: LDA 0,MSSYS ; REPORT SYS.DR ERROR ER1 1 JMP FATER FATER: LDA 3,SSOSP,3 ; WHOA DSZ SSRTN,3 S CLOS SYSCH ; CLOSE SYS.DR CHANNEL NOP RTRN NAMP= 1 ; POINTER TO SYSTEM NAME HIT= NAMP+1 ; HIT\ FLAG NOTF= HIT+1 ; NOT FLAG (/N) STACK= NOTF ; STACK LENGTH STACK CNAME: STA 0,NAMP,3 ; SAVE POINTER TO SYS.DR ENTRY CLER NOTF HIT ; CLEAR HIT AND NOT FLAGS LDA 0,IP,2 ; GET ARGUMENT POINTER CNAM1: C GETAR ; GET AN ARGUMENT JMP CNAM2 ; END OF LIST=D GO TEST LDA 1,NAMP,3 ; COMPARE NAME C CMPNM JMP CNAM1 ; NO MATCH TRY NEXT ISZ HIT,3 ; MARK THE HIT C GETSW ; GET SWITCHES LDA 2,KNSW AND# 2,1,SZR ; /N ?? ISZ NOTF,3 ; YES SET NOT FLAG LDA 1,SWUS ; MARK IT USED C SETSW JMP CNAM1 ; GET NEXT CNAM2: LDA 1,HIT,3 LDA 0,NOTF,3 MOV 0,0,SNR ; IF NOT GIVE NO MATCH RETURN MOV 1,1,SNR ; IF NO MATCH GIVE NO MATCH RETURN RTRN LDA 2,SSOSP,3 ; RESTORE SSOSP ISZ SSRTN,2 ; ELSE GIVE GOOD RETURN RTRN KNSW: N.SW ; ; INITIALIZATION FOR READING SYS.DRq ; AC0 -> BUFFER (401 WORDS) ; AC1 = CHANNEL NUMBER ; CALL ; RDSIN ; -ERROR RETURN ; -NORMAL RETURN ; ; -2 CHANNEL# ; -1 CURRENT LOGICAL BLOCK# ; 0 ENTRY PTR ; 1 (BEG OF BLK) ENTRY COUNT ; 2 FIRST ENTRY 0 RDSIN: ISZ SSRTN,2 MOVZR 0,2 SUB 0,0 STA 0,51,2 STA 0,-1,2 ; BEGIN WITH BLOCK 0 INCS 0,0 ; MAKE 400 ADD 1,0 ; CHANNEL+BLOCK INCREMENT STA 0,-2,2 MOV 1,2 LDA 0,DIRNP S ROPEN CPU JMP SERR RTRN DIRNP: .+1*2 DIRN: .TXT /SYS.DR/ SERR: LDA 3,SSOSP,3 DSZ SSRTN,3 STA 2,SSAC2,3 RTRN ; ; READ NEXT ENTRY FROM SYS.DR ; AC0 -> BUFFER ; AC1 = CHANNEL # ; AC2 = RETURNED ENTRY ADDRESS ; CALL ; RDSYS ; -ERROR OR EOF (CODE IN AC2) ; -NORMAL RETURN CHAN=1 1 RDSYS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN MOVZR 0,2 ; BUILD BUFFER ADDRESS .LOOP: LDA 0,1,2z MOV# 0,0,SZR JMP ENTF INC 2,0 LDA 1,-1,2 ISZ -1,2 LDA 2,-2,2 S RDB CPU JMP SERR NEG 0,2 COM 2,2 INC 0,0 STA 0,0,2 JMP .LOOP ENTF: LDA @0,0,2 ; NAME WORD MOVZ 0,0,SZR MOVO 0,0 ; SET CARRY IF NON VACENT LDA 0,ENTSZ LDA 1,0,2 ADD 1,0 STA 0,0,2 MOV# 0,0,SNC JMP .LOOP DSZ 1,2 JMP .+1 LDA 2,SSOSP,3 STA 1,SSAC2,2 RTRN ENTSZ: UFDEL ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FRAME SIZE .STSZ SO}NTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX C WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX: .+1*2 .TXT /^C.^W/ ; CMPNM ; ROUTINE TO COMPARE SYSTEM NAME WITH A USER NAME. ; AC1 POINTS TO THE SYSTEM NAME ; AC0 POINTS TO THE USER NAME ; * WILL MATCH ANY SINGLE CHARACTER ; -(MINUS SIGN) }WILL MATCH ANY NUMBER ; (INCLUDING 0) OF CHARACTERS ; CALL ; CMPNM ; - NO MATCH RETURN ; - MATCH RETURN SPNT =1 ; HOLDS POINTER TO SYSTEM NAME UPNT =SPNT+1 ; POINTER TO USER NAME SCNT =UPNT+1 ; # OF CHAR LEFT IN SYSTEM NAME UCNT =SCNT+1 ; # LEFT IN "USER NAME TO PROCESS STXSX =UCNT ; STACK SIZE NEEDED FOR UNMSCN ROUTINE SEXT =UCNT+1 ; POINTS TO SYSTEM NAME EXTENSION STYSZ =SEXT ; STACK SIZE NEED FOR CMPNM ROUTINE STYSZ ; COMPARE SYSTEN NAME ROUTINE START ADDRESS ; ALL REGS ARE SAVED ON STACK ON4> ENTRY ; SAVE START ADDRESS OF NAMES FOR PROCESSING CMPNM: STA 0,UPNT,3 ; SAVE START OF USER NAME STA 1,SPNT,3 ; AND SYSTEM NAME TO MATCH LDA 0,C12 ; GET MAX SIZE OF NAME ADD 0,1 ; CALC ADDRESS OF SYSTEM NAME EXTENXION STA 1,SEXT,3 ; AND SAVE IT ; S}ET IN THE MAX # OF CHARS ALLOWED IN SYSTEM AND USER NAMES STA 0,UCNT,3 ; SET THAT 12 IS HIGHEST STA 0,SCNT,3 ; ALLOWED ; SEE IF THE NAME MATCHES C NMSCN ; GO SCAN THE NAME RTRN ; IF NO MATCH THEN TELL OUR CALLER ELSE ; HAD A MATCH, CHECK IF USER NABME IS ALL DONE(IE ENDED IN ZERO BYTE) L1: LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE MATCH ENDED C LDBT ; GET CHAR MOV# 1,1,SNR ; IF IS ZERO THEN USER NAME IS DONE JMP L2 ; GO MAKE SURE SYSTEM NAME DOES NOT ; HAVE EXTENSION ISZ UPNT,3 ; INC TO NEXT CHAR POSITION IN USER NAME LDA 0,PER ; CHECK FOR PERIOD IN USER NAME INDICATING SUB# 0,1,SZR ; AN EXTENSION IS PRESENT, IF NOT THEN JMP L1 ; LOOP TO LOOK MORE AT STRING ELSE ; SET UP TO MATCH THE NAME EXTENSIONS LDA 0,SEXT,3 ; GET ADDRESS O`F SYSTEM NAME EXTENSION STA 0,SPNT,3 ; AND SET TO SCAN LDA 0,C2 ; SET MAX SIZE OF EXTENSION STA 0,SCNT,3 ; TO BE 2 FOR USER AND SYSTEN STA 0,UCNT,3 ; NAMES ; SCAN THE EXTENSION FOR CORRECTNESS C NMSCN ; SCAN THE EXTENSION RTRN ; GIVE UP ON NO MA_TCH ELSE JMP L3 ; WE HAVE NAMES THAT MATCH ; USER NAME HAS NO EXTENSION, CHECK IF SYSTEN NAME HAS EXTENSION L2: LDA 0,SEXT,3 ; GET ADDR OF EXTENSION C LDBT ; GET 1ST CHAR OF IT MOV# 1,1,SZR ; IF HAS EXTENSION THEN RTRN ; NO MATCH ELSE ; WE HAVrE A NAME MATCH, RETURN TO CALLER AT MATCH ADDRESS L3: LDA 2,SSOSP,3 ; GET CALLER STACK POINTER ISZ SSRTN,2 ; INC RETURN POINTER TO MATCH ADDR RTRN ; RETURN TO CALLER PER: ". ; PERIOD SEPARATING FILE NAME FROM EXTENASION DASH: "- ; ANY LENGTH MATCH CH-=AR STAR: "* ; ANY CHAR MATCH C12: 12 ; # OF CHARS IN FILE NAMES C2: 2 ; # OF CHARS IN FILE NAME EXTENSIONS ; INTERNAME ROUTINE FOR "CMPNM" TO TRY FOR MATCH OF WHAT IS LEFT ; OF STRING. ON ENTRY AC2 POINTS TO THE STACK OF THE CALLER ; WHICH CONTAINS WHER9E THE CALLER WAS IN COMPARING THE 2 STRINGS. ; THIS ROUTINE STARTS AT WHERE THE CALLER LEFT OFF AND SCANS THE LINE ; IF NO MATCH THEN RETURNS TO CALLER AT CALL+1 WITH NOTHING CHANGED. ; IF MATCH THEN UPDATES THE USER POINTER IN THE CALLERS STACK TO ; POINT TO THE CHAR THAT ENDED THE COMPARE AND RETURNS AT CALL+2. ; IF ROUTINE ENCOUNTERS DASH THEN IT CALLS ITSELF WITH THE USER NAME ; POINTER POINTING TO THE CHAR AFTER THE DASH. IF ON RETURN IT HAS A ; MATCH THEN IT RETURNS TO ITS CALLER WITH A MATCH. IF NO 3iMATCH THEN ; INCREMENTS THE SYSTEM NAME POINTER BY ONE AND CALLS ITSELF AGAIN. ; PROCESS CONTINUES TILL EITHER MATCH OR SYSTEM FILE NAME ; EXHAUSTED. STXSX ; ROUTINE STACK SIZE NMSCN: ; ROUTINE START ADDRESS ; COPY WHERE CALLER WAS AT IN SCAN TO OWN STACK LDA 0,SPNT,2 ; GET WHERE WAS AT IN SYSTEM NAME STA 0,SPNT,3 ; SAVE IN OWN STACK LDA 0,UPNT,2 ; GET WHERE AT IN USER NAME STA 0,UPNT,3 ; AND STORE LDA 0,SCNT,2 ; GET # CHARS MAX LEFT IN SYSTEM NAME STA 0,SCNT,3 ; AND STORE IT LDA 0,UCNT,2 ; SAME WITH USER NAME STA 0,UCNT,3 ; GET CHAR FROM EACH STRING TO MATCH NM1: LDA 0,UPNT,3 ; PICK UP CHAR FROM C LDBT ; USER STRING MOV 1,2 ; AND SAVE IN AC2 SUB 1,1 ; SET SYSTEM CHAR TO NULL AND LDA 0,SCNT,3 ; IF END OF SYSTEM STRING MOV# 0,0,SNR ; REACHED CHECK TO SEE JMP NM15 ; IF USER CHAR WAS NULL LDA 0,SPNT,3 ; ELSE PICK UP CHAR C LDBT ; FROM SYSTEM STRING ; CHECK TO SEE IF THEY ARE EQUAL NM15: SUB# 1,2,SZR ; IF NOT EQUAL THEN JMP NM3 ; BRANCH ELSE ; WE HAVE MATCH, SEE IF MATCH IS TH{AT OF END OF STRINGS MOV# 2,2,SNR ; IF WE ARE AT END OF STRINGS THEN JMP NM5 ; NAMES MATCH ELSE ; NAMES NOT ALL MATCHED YET, CHECK TO SEE IF HAVE REACHED END OF ; WHAT SHOULD BE PROCESSED IN NAMES NM2: ISZ UPNT,3 ; UPDATE NAME POINTERS TO ISZ SPNT,3 n ; NEXT CHAR DSZ SCNT,3 ; COUNT SYSTEM NAME CHAR NOP DSZ UCNT,3 ; IF HAVE NOT MATCHED MAX # USER JMP NM1 ; CHARS THAN GET NEXT CHAR ELSE JMP NM5 ; WE HAVE COMPLETE MATCH ; CHARS DID NOT MATCH, CHECK FOR SPECIAL CHARS NM3: LDA 0,PER ; IF USER NAM E CHAR IS A SUB# 0,2,SNR ; PERIOD THEN IS END OF USER JMP NM4 ; USER NAME SO BRANCH ELSE LDA 0,DASH ; IF IS DASH THEN GO SUB# 0,2,SNR ; WHAT PART OF REST OF SYSTEM NAME JMP NM9 ; MATCH USER NAME ELSE LDA 0,STAR ; IF IS STAR AND THE SYSTEM SUB#:B 0,2,SNR ; NAME CHAR IS NOT A ZERO THEN MOV# 1,1,SNR ; SAY THE CHARS MATCH ELSE RTRN ; RETURN WITH NO MATCH JMP NM2 ; FOUND PERIOD IN USER NAME, CHECK THAT SYSTEM NAME IS ENDED NM4: MOV# 1,1,SZR ; IF SYSTEM NAME DID NOT END AT RTRN ; SAME POINTF AS USER THEN NO MATCH ELSE ; NAMES DO MATCH, RETURN ADDRESS OF WHERE MATCH ENDED IN USER NAME ; TO CALLER. NM5: LDA 2,SSOSP,3 ; GET ADDRESS OF CALLER STACK LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE ENDED STA 0,UPNT,2 ; RETURN TO CALLER ; INC RETURN ADDR TO SUCCESSFUL RETURN ADRESS AND DONE ISZ SSRTN,2 RTRN ; FOUND DASH IN USER NAME, INC PAST THE DASH NM9: ISZ UPNT,3 ; CHECK, IF DASH WAS LAST CHAR OF NAME THEN WE HAVE A MATCH LDA 0,UPNT,3 ; GET POINTER TO USER NAME C LDBT ; GET NEXT CHAR OF NA#ME LDA 0,PER ; IF IT IS ENDED THEN SUB# 0,1,SZR ; WE HAVE A MATCH ELSE MOV# 1,1,SNR ; WE HAVE NO MATCH JMP NM5 ; MATCH ; SEE IF WHAT IS LEFT OF USER NAME MATCHES WHATS LEFT OF SYSTEM NAME NM10: C NMSCN ; SCAN NAMES FOR MATCH MOV# 1,1,SKP ; IF NfO MATCH THEN SKIP ELSE JMP NM5 ; IF MATCH THEN WOOPY, GO RETURN SUCCESS ; DOES NOT MATCH, SEE IF ANYTHING LEFT OF SYSTEM NAME TO TRY MATCH ISZ SPNT,3 ; INC SYSTEM NAME POINTER TO NEXT CHAR DSZ SCNT,3 ; IF STILL SOMETING LEFT OF NAME THEN MOV# 0,0,SKP ; SKIP ELSE RTRN ; RETURN WITH NO MATCH ; NOT PAST MAX # OF CHARS IN SYSTEM NAME, STILL CHECK FOR NAME END LDA 0,SPNT,3 ; GET POINTER TO SYSTEM NAME C LDBT ; GET CHAR FROM IT MOV# 1,1,SNR ; IF IS END OF SYSTEM NAME THEN RTRN ; NO MATCH POSSI' BLE ELSE JMP NM10 ; GO SEE IF MATCH MACEX.SR5  ; ; MACEX- ; EXPAND CLI MACRO INTO TBUFF. ; ON ENTRY, MACRO FILE IS OPEN ON INSCH ; AC0 = CURRENT POINTER IN TBUFF ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMACEXW .RB CMACEX.RB ** .ENDC J .TITL BMACEX .RB BMACEX.RB **[J] .NREL .ENT MACEX ; ENTRY POINT .EXTN CALL RTRN ; LINK ROUTINES .EXTN RDLIN ; READ LINE INTO BUFFER .EXTN PCBUF ; PUT CHARACTER IN BUFFER .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN PSUSHB ; PUSH BUFFER STATE .EXTN CBUFR ; ADDRESS OF CBUFF HEADER .EXTN TBUFR ; ADDRESS OF TBUFF HEADER ; DEFINE THE STACK EXBFA=1 ; CURRENT POINTER IN TBUFF STACK= EXBFA ; STACK SIZE ; ; SET UP TBUFF FOR MACRO ; STACK MACEX: STA 0,EXBFA,3 ; SAVE CURRENT POINTER LDA 2,.TBUFR ; AC2 => TBUFF HEADER C GCBUF ; GET NEXT CHARACTER LDA 0,MCEOT ; IF IT IS NOT AN EOT SUB# 0,1,SZR ; THEN PUSH BUFFER JMP MCPSH ; STATE ELSE LDA 0,BFRPT,2 ; RESET START OF STA 0,BFFFB,2 ; BUFFER FRAME JMP INSR1 ; AND INSERT MACRO FILE. MCPSH: LDA 1,EXBFA,3 ; AC1 = CURRENT POINTER C PUSHB ; PUSH BUFFER STATE ; ; INSERT MACRO FILE INTO TBUFF ; INSR1: LDA 1,.INSCH ; AC1 <= CHANNEL NUMBER INSRT: C RDLIN ; INSERT A LINE INTO TBUFF JMP MCEOF ; END OF MACRO FILE JMP CINSRT ; MORE- GO GET IT MCEOF: S CLOS INSCH ; CLOSE MACRO FILE NOP ; IGNORE ERROR RETURN LDA 2,.TBUFR ; RESTORE AC2 IN CASE OF ERROR. DSZ BFFFB,2 ; IF MORE THAN ONE BYTE IN BUFFER JMP CHKCR ; THEN SEE IF THERE IS A C/R JMP PUTBK ; ELSE JUST RESTORE E0OT. CHKCR: LDA 0,BFFFB,2 ; PICK UP FREE BYTE POINTER NEG 0,0 ; AND BACK IT UP ONE CHAR COM 0,0 ; BEFORE EOT. C GCBUF ; GET CHARACTER- LDA 0,MCCAR ; IF IT IS SUB# 0,1,SNR ; A C/R THEN JMP PUTBK ; JUST RESTORE EOT ELSE MOV 0,1 ; STORE A C/R TO INS0URE C PCBUF ; PROCESSING OF MACRO. PUTBK: LDA 1,MCEOT ; RESTORE EOT C PCBUF ; IN TBUFF. ; ; SET UP CBUFF FOR MACRO ; LDA 2,.CBUFR ; RESET CBUFF LDA 0,BFRPT,2 ; FOR NEXT STA 0,BFFFB,2 ; COMMAND LINE RTRN ; THAT'S ALL FOR NOW .CBUFR: CBUFR .TBUF- R: TBUFR .INSCH: INSCH MCCAR: EOL MCEOT: EOT MKSAV.SR5 Kw ; SAVED FILE MAKER ; AC0 POINTS TO THE EDITED COMMAND STRING ; TWO ARGUMENTS ARE EXPECTED ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMKSAV .RB CMKSAV.RB ** .ENDC J .TITL BM=KSAV .RB BMKSAV.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT MKSAVE .EXTN CALL,GETARG,RTRN .EXTN WRLIN,MKFIL,ERR1,ERR2,GETSW ICH= COMCH ** .DO CCOND OCH= PUSCH ** .ENDC J OCH= TMPCH **[J] NAME= 1 ; FILE NAME SPACE NAMP= NAME+30 ; NA &ME POINTER INP= NAMP+1 ; INPUT NAME PTR CADDR= INP+1 MKACO= CADDR+1 ; MKACO IS A 'PSEUDO-AC ' USED ; TO HOLD THE INPUT WORD FOR RDOS WRITE MKADR= MKACO+1 ; MKADR IS A LOCATION COUNTER USED TO ; INFORM RDOS OF RELATIVE POSITIONS OF ; DATA IN OR DER TO CONSTRUCT A CORE IMAGE ; ON THE DISK BMKACO= MKADR+1 ; BYTE POINTER TO MKACO BMKADR= BMKACO+1; BYTE POINTER TO MKADR WDCNT= BMKADR+1; WORD COUNT FROM TAPE BLOCK BWDCNT= WDCNT+1 ; BYTE POINTER TO WORD COUNT CHKSUM= BWDCNT+1; CHECKSUM STORAGE ?U SWITCH= CHKSUM+1; SWITCH IS USED TO TEST WHETHER ; MULTIPLE DATA BLOCK IS BEING PROCESSED PEND= SWITCH PEND ; NEEDED BY SAV. ROUTINE IN (SUBROUTINE -1) ; POSITION IN ORDER TO SAVE SPACE ON THE STACK ; FOR ALL TEMPS USED BY SUBROUTINE MKSAV?E: ISZ SSRTN,2 ; ASSUME GOOD RETURN C GETSW ; GET THE SWITCHES ON COMMAND LDA 1,ZSW ; MASK FOR Z SWITCH AND 1,2 ; SWITCH SETTING RETURNED IN 2 LDA 1,FRADD ; THE NUMBER 016,ULTIMATELY MOV# 2,2,SZR ; SKIP IF SWITCH WAS SET SUB 1,1 ; OTHERWISE, STOREq3 ZERO INTO CADDR STA 1,CADDR,3 ; INSTEAD OF 016 CALL GETARG ; LOOK AT FIRST ARG. JMP @NOARD ; ERROR RETURN FOR NO ARGUMENT SUB 1,1 S OPEN,ICH JMP @.OPER STA 0,INP,3 ; SAVE INPUT NAME PTR CALL ; LOOK AT OTHER ARG. GETARG ; JMP @NOARD ; BETTER bBE THERE LDA 2,NAMD ADDZL 3,2 ; BYTE PTR TO NAME IN STACK STA 2,NAMP,3 ; SAVE IT LDA 1,SEXT ; EXT PTR CALL ; MAKE SAVED FILE MKFIL JMP @WRAD ; SOME ERROR MOV 2,0 ; TRY TO OPEN IT S OPEN,OCH JMP @.OPER JMP MKSA0 ; GO AND BEGIN READING FROM THE PAPER TAPE ; SAYETH THY GOD, THE ALMIGHTY, THE LORD OF HOSTS IRDERR: RDERR ; INDIRECT TO READ ERROR RETURN .OPER: OPER X=0 ; #WORDS NECESSARY FOR MKSA7 ON STACK K20: 20 ; VARIOUS KONSTANTS K177: 177 K312: 312 K377: 377 NOARD: NOARG ZSW: 1B9 FRADD:< SCSTR NAMD: NAME WRAD: WRERR SEXT: SEX*2 ; POINTER TO TEXT /.SV/ ONE: 001 TWO: 002 MKSA0: BPT MKACO BMKACO MKADR BMKADR WDCNT BWDCNT ; THIS HAS CREATED BYTE POINTERS ; THE FOLLOWING CLEARS SOME LOCS CLER MKADR CONT: CLER SWITCH WDCNT SREAD: LDA q}0,BWDCNT,3 ; GET BYTE POINTER ON GENERAL PRINCIPLES LDA 1,ONE ; NUMBER OF BYTES TO BE READ S RDS,ICH ; SYSTEM READ SEQUENTIAL JMP @IRDERR ;READ ERROR LDA 2,WDCNT,3 ; GET THE BYTE MOV 2,2,SNR ; WAS ANYTHING READ? JMP SREAD ; NO, ONLY ZEROS OF THE TAPE? LEADER LDA 0,BWDCNT,3 ; AGAIN, GET BYTE POINTER ON GEN PRIN LDA 1,ONE ; NUMBER OF BYTES TO BE READ INCZ 0,0 ; YES, SO INCREMENT THE BYTE POINTER S RDS,ICH ; AND GET THE REST OF THE FIRST WORD ; INTO WDCNT LOCATION JMP @IRDERR ;READ ERROR LDA 1,WD{CNT,3 ; AND SWAP THE BYTES INTO CORRECT ORDER MOVS 1,1 STA 1,WDCNT,3 ; THE WORD WAS THE NEGATIVE OF WORD COUNT STA 1,CHKSUM,3 ; START CHECKSUM TOTAL ON STACK ; HERE BEGINS THE CHECK FOR TYPE OF PAPER TAPE BLOCK SLTZ 1 ; IS WC LESS THAN ZERO? JMPr MKSA6 ; NO, SO ERROR OR START BLOCK LDA 2,K20 ; YES, SO DATA OR MULTIPLE DATA BLOCK ADDZ# 1,2,SNC ;IS WC GREATER THAN -20? JMP MULT ;NO, SO PROCESS MULTIPLE BLOCK GO: LDA 0,BMKACO,3 ; READ IN ADDRESS OF DATA BLOCK ; STORE IN MKACO TEMPORARILY ; IiN ORDER TO TEST AGAINST OLD WRITE ADDRESS LDA 2,CADDR,3 ; GET OFFSET PRODUCED BY Z SWITCH LDA 1,BMKACO,3 ; GET NEW DATA BLOCK ADDRESS CALL MKSA7 LDA 1,MKACO,3 ;GET THE NEW DATA BLOCK ADDRESS SUBZ 2,1,SNC ;SUBTRACT SWITCH FROM ADDRESS ;SKIP IF ADDR(ESS IS LESS THAN SWITCH JMP PHERR ; TRIED TO STORE ADDRESS LESS THAN ; MINIMUM SPECIFIED BY Z SWITCH ; A TYPE OF PHASE ERROR LDA 0,MKADR,3 ; GET THE OLD ADDRESS STA 1,MKADR,3 ; RESET THE OLD ADDRESS SNE 0,1 ; TEST AGAINST NEW, WHICH IS STILL IN AC1 JMP CKSM ; YES, NO NEED TO RESET SYSTEM WRITE POSITION SUBZ 0,0 ; NO, SET HIGH BYTES OF ADDRESS=0 LDA 1,MKACO,3 ; SET LOW BYTES EQUAL TO NEW LOCATION STA 1,MKADR,3 MOVZL 1,1 ; AND MAKE A BYTE POINTER OUT OF IT S SPOS,OCH ; RESET FILE WRITE ADDRESS JMP @WRAD ; AN OUTPUT ERROR IS A WRITE ERROR ; THIS PROCESSES NORMAL DATA BLOCK BY READING EACH ; WORD INTO MKACO, AND IMMEDIATELY WRITING IT ONTO ; THE DISK IN THE RELATIVE POSITION SPECIFIED ; BY MKADR CKSM: LDA 0,BMKACO,3 ;GET BYTE POINTER CALL ;AND READ THE CHECKSUM MKSA7 ;IMMEDIATELY FORGETTING IT-MKSA7 DOES ADDITION DATA: LDA 0,BMKACO,3 ; SO PROCESS DATA BLOCK CALL ; BMKACO IS BYTE POINTER FOR MKSA7 ; WORD TO BE READ SWTCH: LDA 0,BMKACO,3 ; GET BYTE POINTER FOR WRITE ; NOTE THIS BEGINS REPEAT WRITE FOR ; PROCESSING MULTIPLE DATA BLOCKS LDA 1,TWO ; GET NUMBER OF BYTES TO BE WRITTEN S WRS,OCH ; AND WRITE THEM SEQUENTIAL JMP @WRAD ;WRITE ERROR ISZ MKADR,3 ; INCREMENT WRITE ADDRESS ISZ WDCNT,3 ; TEST OF WHETHER DONE WIOTH DATA BLOCK JMP QSWITCH ; NOT DONE YET, TEST THE SWITCH TO RETURN ; TO APPROPRIATE LOC SKZ CHKSUM ; SKIP IF CHECKSUM=0, AS IT SHOULD JMP CKERR ; CHECKSUM ERROR JMP CONT ; ALL OK, CONTINUE WITH ANOTHER BLOCK QSWITCH: SNZ SWITCH ; IF SWITCH IS GREAfTER THAN ZERO ; IT IS MULTIPLE DATA BLOCK, SO DON'T JMP DATA ; IT IS A MULTIPLE BLOCK, SO NO NEED TO ; READ DATA WHICH IS TO BE WRITTEN JMP SWTCH MULT: ISZ WDCNT,3 ; INCREMENT WORD COUNT FOR N=WC-1 CONVENTION STA 3,SWITCH,3 ; THIS GUARANTEES SWITCH > 0 FOR FUTURE TESTS ; DATA BLOCK-DO NOT READ DATA WORDS JMP GO MKSA6: MOVZR 1,1,SZR ; IS IT A START BLOCK? JMP MKSA9 ; NO, SO IGNORE THE BLOCK LDA 0,BMKADR,3 ; BYTE POINTER FOR START BLOCK ADDRESS CALL MKSA7 ; THIS READS TWO BYTES INTO MKADR  LDA 0,BMKACO,3 ; BYTE POINTER FOR READING CHECKSUM TO MKACO CALL MKSA7 ; READS TWO BYTES INTO MKACO LDA 2,CHKSUM,3 ; GET THE CHECKSUM OF START BLOCK MOV# 2,2,SNR ; IT BETTER BE ZERO JMP ENDS ; IF SO, RETURN TO MAIN CLI PROGRAM JMP CKERR ; IF NOT, C/HECKSUM ERROR, TELL HIM X ; NUMBER OF WORDS NEEDED ON STACK, USED BY CALL ROUTINE MKSA7: LDA 1,TWO ; THIS READS NUMBER OF BYTES ; BYTE POINTER ALREADY IN AC1 FROM CALL S RDS,ICH ; READ THE BYTES JMP RDERR ;READ ERROR MOVZR 0,2 ;MAKE AN ADDRESS F+BROM BYTE POINTER ; IN ORDER TO GET THE DATA WORD READ LDA 0,0,2 ;AND GET THE DATA MOVS 0,0 ;SWAP THE NEWLY READ WORD STA 0,0,2 ;RESTORE IT AS SWAPPED LDA 3,SSOSP,3 ; GET OLD USP FOR REF TO OLD STACK LDA 1,CHKSUM,3 ; GET CHKSUM FROM STACK ADD 0,1 40;ADD IT TO CHECKSUM STA 1,CHKSUM,3 ;AND RESTORE UPDATED CHECKSUM TO STACK RTRN MKSA9: LDA 2,K177 ; GET ASCII RUBOUT=END BYTE OF ERROR BLOCK SUBZ 1,1 ; MAKE A ZERO STA 1,MKACO,3 ; AND CLEAR MKACO WITH IT LDA 0,BMKACO,3 ; GET BYTE POINTER LDA 1,ONE ; GET NUMBER OF BYTES TO BE READ S RDS,ICH ; AND READ THEM JMP RDERR ;READ ERROR LDA 1,MKACO,3 ; GET THE BYTE READ SUB# 1,2,SZR ; WAS IT A 377? JMP MKSA9 ; NO SO TRY IT AGAIN JMP CONT ; YES,SO GET THE NEXT BLOCK NOARG: LDA 2,NOARM ; NOT ENUF ARGS. JMP ERR ERET: LDA 2,SSOSP,3 DSZ SSRTN,2 RET: S CLOS,ICH JMP .+1 S CLOS,OCH JMP .+1 RTRN CKERR: LDA 2,CKRM ; CHECKSUM ERROR JMP ERR PHERR: LDA 2,PHM ; PHASE ERROR ERR: ER2 3 JMP RET JMP ERET RDERR: LDA 0,INP,3 ; FILE NAME PTR JMP OPER ENDS: LDAA 0,ATR S CHATR,OCH NOP JMP RET ATR: ATSAV WRERR: LDA 0,NAMP,3 OPER: ER1 3 JMP RET JMP ERET ;RANDOM STUFF EOF: EREOF SEX: .TXT /.SV/ NOARM: CNEAR CKRM: CCKER PHM: CPHER .END CHATR.SR5  "0 ; ; CHANGE ATTRIBUTES COMMAND SUBROUTINE ; CALLED WITH POINTER TO EDITED ; COMMAND LINE IN AC0 ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CCHATR .RB CCHATR.RB ** .ENDC J .TIaTL BCHATR .RB BCHATR.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CHATR ; CHANGE FILE ATTRIBUTES .ENT CHLAT ; CHANGE LINK ATTRIBUTES .EXTN CALL LDBT RTRN GETARG WRLIN CHAN= COMCH ; CHANNEL FOR CHANGING ATTRIBUTES ; DEFINE THE STACK CP_q= 1 ; CUR COMMAND LINE PTR NAMP= CP+1 ; PTR TO FILE NAME ATRPX= NAMP+1 ; PTR TO FILE ATTRS ATRS= ATRPX+1 ; ACCUMULATED ATTRIIBUTES TMP1= ATRS+1 ; ATTRIBUTE BIT TABLE WORKING POINTER WAY= TMP1+1 ; CHATR/CHLAT INDICATOR OLDAT= WAY+1 ; PLACE FOR CURRENT_ ATTRIBUTES CURAT= OLDAT+1 ; ANOTHER PLACE FOR SAME MODE= CURAT+1 ; + / - MODE SWITCH STAIP= MODE+1 ; POINTER TO STATS STATI= STAIP+1 ; STATS AREA PEND= STATI+UFDEL ; STACK SIZE PEND CHLAT: SUB 1,1 ; SET PATH FOR CHLAT JMP CHATR+1 PEND CHATR: |SUBZL 1,1 ; SET PATH FOR CHATR STA 1,WAY,3 ; MARK THE PATH ISZ SSRTN,2 ; SET GOOD RETURN LDA 1,STAID ; BUILD POINTER TO STATS AREA ADDZ 3,1 STA 1,STAIP,3 ; AND SAVE IT IN THE STACK AGAIN: C GETAR ; GET FILENAME JMP @.RETRN ; ALL DONE STA 0,NAMP,3 ; NAME PTR C GETARG ; GET ATTRS PTR JMP NOARG ; UNMATCHED SET - COMPLAIN STA 0,ATRPX,3 ; SAVE STA 0,CP,3 ; SAVE SPOT IN COMMAND LINE LDA 0,NAMP,3 ; NAME PTR AGAIN LDA 1,STAIP,3 ; GET STATS ON FILE S STAT JMP OPER ; ERROR LDA 0,STATI+UFTAT,3 ; GET 5EXISTING ATTIBUTES LDA 1,LINAT AND# 1,0,SZR ; A LINK ?? JMP ATPRO ; YES GO NO FURTHER LDA 1,.ATCHP ; ATTRIBUTE PROTECTED AND# 1,0,SZR ; WELL ?? JMP ATPRO ; YES DON'T BOTHER CHECKING SNZ WAY ; CHANGING ATRIBUTES ?? LDA 0,STATI+UFTLK,3 ; NO LINK ATTRIBUTES STA 0,OLDAT,3 ; SAVE WHAT IS THERE STA 0,CURAT,3 ; IN TWO PLACES. CLER ATRS ; NO ATTRIBUTES TO START LDA 1,.ATSAV ; IS SAVE FILE ATTRIBUTE SET? AND# 0,1,SNR ; IF IT IS NOT SET THEN JMP NOTSV ; LEAVE NEW ATTRIBUTES = 0 STA 1,ATRS,3 ; ELSE SET SAVE FILE BIT. NOTSV: CLER MODE ; START OUT IN + MODE INATS: LDA 0,ATRPX,3 ; AC0 => INPUTTED NEXT ATTRIBUTE ISZ ATRPX,3 ; BUMP POINTER C LDBT ; AC1 <= NEXT ATTRIBUTE MOV# 1,1,SNR ; FINISHED? JMP ENDAT ; YES- GO FINISH UP LDA 0,.PLUS ; AC0 <= + \ SUB# 0,1,SZR ; IF THIS IS NOT A + JMP MINUS ; THEN CHECK IF - CLER MODE ; ELSE SET MODE = + JMP GTOLD ; AND ADD IN OLD ATTRIBUTES. MINUS: LDA 0,.MINUS ; AC0 <= - SUB# 0,1,SZR ; IF THIS IS NOT A - JMP CHKAT ; THEN IT MIGHT BE AN ATTRIBUTE ISZ MODE,3 {; ELSE SET MODE = - GTOLD: LDA 0,OLDAT,3 ; AC0 <= OLD ATTRIBUTES CLER OLDAT ; THIS CAN ONLY HAPPEN ONCE!! JMP SETAT ; NOW GO SET THEM IN (IF FIRST TIME) CHKAT: MOV 1,2 ; AC2 <= ATTRIBUTE CLER OLDAT ; ZIP OLD ATTRIBUTES LDA 0,ATTRD ; AC0 => ATTRIBUTE wWBIT TABLE STA 0,TMP1,3 ; SAVE AS WORKING POINTER LDA 0,CARP ; AC0 => ATTRIBUTE TABLE ATRLP: C LDBT ; AC1 <= NEXT ATTRBUTE FROM TABLE MOV# 1,1,SNR ; IS THIS THE END OF THE TABLE? JMP ILAT ; YES- INPUTTED ATTRIBUTE IS ILLEGAL SUB# 1,2,SNR ; IS THIS THE ATTRIBUTE? JMP GOTIT ; YES- GO PROCESS INC 0,0 ; NO- BUMP ATTRIBUTE TABLE POINTER ISZ TMP1,3 ; BUMP BIT TABLE POINTER JMP ATRLP ; TRY AGAIN GOTIT: LDA @0,TMP1,3 ; AC0 <= ATTRIBUTE BIT  COM# 0,0,SNR ; WAS THIS A "*" ENTRY LDA 0,CURAT,3 ; YES- GIVE ALL OF THE CURRENT SKZ MODE ; IF THIS IS - MODE JMP CLRAT ; THEN CLEAR THESE BIT(S) SETAT: LDA 1,ATRS,3 ; ELSE ADD THEM IN COM 0,0 ; BY PERFORMING AND 0,1 ; THE RIDICULOUS NOVA ADC 0,1 ; INCLUSIVE OR FUNCTION!! STA 1,ATRS,3 ; NOW SET NEW ATTRIBUTEuS JMP INATS ; AND SEE IF MORE TO PROCESS CLRAT: LDA 1,ATRS,3 ; AC1 <= NEW ATTRIBUTES COM 0,0 ; MASK ATTRIBUTES TO BE KEPT AND 0,1 ; AND CLEAR ONES TO BE REMOVED STA 1,ATRS,3 ; SET NEW ATTRIBUTES JMP INATS ; AND SEE IF MORE TO PROCESS .RETRN: RETRN STAID: STATI .ATSAV: ATSAV LINAT: ATLNK .ATCHA: ATCHA .MINUS: "- .PLUS: "+ ENDAT: LDA 0,STATI+UFTAT,3 ; GET OLD ATTRIBUTES SNZ WAY ; CHLAT ?? LDA 0,STATI+UFTLK,3 ; YES GET LINK ATTRIBUTES LDA 1,ATRS,3 ; NEW ONE ?? SUB# 1,0,SNR ; SAME ?? JMP RET1 ; l YES SAVE SOME TIME LDA 0,NAMP,3 ; NO OPEN THE FILE ADC 1,1 ; DON'T DO ANYTHING RASH S OPEN CHAN JMP OPER LDA 0,ATRS,3 ; GET THE NEW ATTRIBUTES SKZ WAY ; WHICH WAY JMP NCLOS ; NORMAL S CHLAT CHAN ; LINK JMP ATERR ; GOOD HEAVENS JMP RET ; GO CLOSE UP NCLOS: S CHATR CHAN ; CHANGE THE ATTRIBUTES JMP ATERR RET: S CLOS CHAN ; CLOSE THE FILE NOP RET1: LDA 0,CP,3 ; GET ARG POINTER JMP AGAIN ; TRY NEXT ; NOT ENOUGH ARGUMENTS NOARG: LDA 2,NOARM ER2 4 ; GIVE ERROR JMP RETRN JMP FRTN ; ILLEGAL ATTRIBUTE ILAT: DSZ ATRPX,3 ; BACK UP ONE LDA 0,ILLAD ; AC0 => ERROR MESSAGE C WRLIN ; REPORT ERROR ATRPX+400 ISZ ATRPX,3 ; RESTORE POINTER JMP INATS ; REJOIN PROCESSING LOOP ; OTHER ERRORS ATPRO: LDA 2,.ERCHA ; AC2 <= ATTRIBUTE PROTECTED ATEbRR: LDA 0,NAMP,3 ; AC0 => FILE NAME OPER: ER1 4 ; REPORT ERROR JMP RET ; NOT FATAL CONTINUE ; RETURNS FRTN: LDA 2,SSOSP,3 ; RESTORE OLD STACK POINTER DSZ SSRTN,2 ; SET FOR ERROR RETURN RETRN: S CLOS CHAN ; CLOSE CHANNEL JUST IN CASE NOP RTRN NOARMQ: CNEAR .ERCHA: ERCHA ATTRD: .+1 ; ATTRIBUTE BIT TABLE -1 ATRP ATSAV ATPER ATWP ATNRS ATUS1 ATUS2 0 ** .NOLOC 1 CARP: .+1*2 ; ATTRIBUTE TABLE .TXT /*RSPWN&?0/ ILLAD: .+1*2 .TXT /ILLEGAL ATTRIBUTE: ^F<15>/ ** .NOLOC 0 CNAME.SR5 V  ;CSNAM ;CUNAM ; COMPARE NAME POINTED TO BY AC0 TO ; NAMES IN TABLE POINTED TO BY AC1 ; ; CXNAM ; (ERROR RETURN) ; NO MATCH ; (NORMAL RETURN) ; AC1 -> USE COUNT OF MATCHING ENTRY ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T rLIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CCNAME .RB CCNAME.RB ** .ENDC J .TITL BCNAME .RB BCNAME.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CSNAM CUNAM .EXTN USTSN CMPNM CALL RTRN TABL= 1 NAMP= TABL+1 NAME= NAMP+1 STACK= NAMEMn+6 STACK CUNAM: STA 1,TABL,3 ; SAVE POINTER TO TABLE BPT NAME NAMP ; FORM POINTER TO NAME C USTSN ; CONVERT USER NAME TO SYSTEM NAME JMP CNAM1 ; JOIN COMMON CODE NAME CSNAM: STA 0,NAMP,3 ; SAVE NAME STA 1,TABL,3 ; SAVE TABLE POINTER JMP CNAM1 ; GO GET ENTRY CNAM0: ISZ TABL,3 ; BUMP TO NEXT ENTRY CNAM1: LDA 0,@TABL,3 ; GET A NAME ISZ TABL,3 COM# 0,0,SNR ; END OF TABLE ?? RTRN ; YES RETURN LDA 1,NAMP,3 ; YES TRY FOR MATCH C CMPNM JMP CNAM0 ; NO MATCH TRY AGAIN LDA 1,TABL,3 ; AC1 -> USE COqduUNT OF WINNER LDA 2,SSOSP,3 ; BUMP RETURN STA 1,SSAC1,2 ; RETURN POINTER ISZ SSRTN,2 RTRN ; RETURN .END COMS.SR5-T ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS .NREL ** .DO CCOND .TITL CCOMS .RB CCOMS.RB .ENT STOD GTOD GTODC SDAY .ENT SQUAS INITC RLSEC DIR .ENT REVNO .ENT CREA CCON CPAR CRAN .ENT APPEND RENAMEt SPACE .ENT SPEBL SPKIL SPDIS .ENT BOOT .ENT SPY KSPY .ENT REPLACE .ENT PPOP .EXTN CALL RTRN .EXTN GETARG GETSW .EXTN MKNAM .ASCD VRFIL .EXTN WRLIN WRBIN WRLCH .EXTN .INDEX CMOVE COMP MOVE .EXTN SPYF .EXTN SPARG ; SPY ARGUMENT SPACE .EXTN CURDR ; POINTER TO CURRENT DIRECTORY NAME .EXTN LSTDR ; POINTER TO PREVIOUS DIRECTORY NAME ** .ENDC T .TITL BCOMS .RB BCOMS.RB .ENT GTOD GTODC RLSEC DIR CREA CCON CRAN .ENT APPEND RENAME SPACE GTCH REPLACE REVNO .EXTN CALL RTRN ERR1 ERR2 COMP STBT .EXTN GETARG MKNAM .ASCD WRLIN .EXTN WRLCH COMP GETSW MOVE .EXTN VRFIL .EXTN .D1 BDSMS MDCNT BMDIR ** [T] .TXTM 1 ; PACK 'EM LEFT TO RIGHT ; ; CREATE RANDOM/SEQUENTIAL FILES ; 0 CRAN: SUBZ 1,1 ; SET CRAND FLAG JMP CR0 0 CREA: MOVZ 1,1 ; SET CR"EATE FLAG CR0: ISZ SSRTN,2 CREA1: C GETAR ; GET ARGUMENT RTRN ; NO MORE ARGS MOVC# 0,0,SNC ; CHECK FOR CRAND OR CREATE JMP CR1 S CREA ; CREATE SEQUENTIAL FILE JMP ERRCR ; SOME ERROR JMP CREA1 CR1: S CRAND ; CREATE RANDOM FILE JMP ERRCR JMP CREWA1 ERRCR: ER1 4 ; REPORT ERROR TO PROPER PLACE JMP CREA1 ; CONTINUE JMP .FRTN ; HE WANTS US TO QUIT ; ; CREATE CONTIGUOUS FILES ; ; DEFINE THE STACK NMP= 1 ; POINTER TO CURRENT NAME LNP= NMP+1 ; RUNNING LINE POINTER NSW= LNP+1 ; GLOBAL/N SWITCH NFLAG NSW ; STACK SIZE CCON: ** .DO CCOND MOVZ 0,0 ; SET ENTRY FLAG CCON0: ** .ENDC ISZ SSRTN,2 ; SET GOOD RETURN STA 0,LNP,3 ; SAVE LINE POINTER C GETSW ; GET GLOBAL SWITCHES SW N ; SET GLOBAL/N FLAG FOR CCONT LDA 0,LNP,3 ; RESTORE LINE POINTER ГCCON1: C GETARG ; GET NAME RTRN ; NO MORE NAMES- BYE! STA 0,NMP,3 ; SAVE POINTER TO NAME C GETARG ; LENGTH IN BLOCKS JMP NOARG ; ERROR- MUST HAVE LENGTH STA 0,LNP,3 ; SAVE RUNNING LINE POINTER C .ASCD ; CHANGE TO DECIMAL INTEGER JMP ERRCC ; INVALIID INPUT LDA 0,NMP,3 ; RESTORE NAME POINTER ** .DO CCOND MOV# 0,0,SZC ; CCONT OR CPART ? JMP DOPAR ; DO CREATE PARTITION ** .ENDC LDA 3,NSW,3 ; GET GLOBAL/N FLAG SEQZ 3 ; IF /N SET JMP NOZRO ; THEN DO .CONN. S CCONT ; CREATE CONTIGUOUS WITH ZEROED dDATA JMP ERRCC ; SOME TYPE OF ERROR JMP RECYC ; OK- KEEP ON GOING NOZRO: S CONN ; CREATE CONTIGUOUS NO ZEROED DATA JMP ERRCC ; SOME TYPE OF ERROR RECYC: LDA 0,LNP,3 ; RESTORE RUNNING LINE POINTER JMP CCON1 ; AND KEEP GOING. ; REPORT ERRORS ERRCC: ER>1 4 ; SEND ERROR TO PROPER PLACE JMP RECYC ; TRY AGAIN .FRTN: JMP FRTN ; FATAL !! ** .DO CCOND ; ; CREATE PARTITIONS ; LNP CPAR: MOVO 0,0 ; SET ENTRY FLAG JMP CCON0 ; JOIN COMMON PATH DOPAR: S CPART ; CREATE PARTITION JMP ERRCC ; SOME TYPE OF ERROR JMP RECYC ; OK- KEEP ON GOING ** .ENDC ** .DO CCOND ; ; POP A LEVEL ; 0 ; STACK SIZE PPOP: ISZ SSRTN,2 ; SET GOOD RETURN S FGND ; GET PROGRAM PROGRAM LEVEL JMP ERRX ; SOMETING IS REALLY WRONG LDA 2,USTP ; AC2 => UST LDA 0,USTPC,2 ; AC0 = 0 IF BACK/ =1 IF FORE ADDOL 0,0 ; 1 IF BG/ 5 IF FG SUB 0,1,SZR ; AT LEVEL 0 ?? JMP RT ; NO- GO POP OFF LDA 2,ERRZ ; LEVEL=0 CANT POP JMP ERRX RT: S RTN ; POP A LEVEL JMP ERRX JMP ERRX ERRZ: ERRTN ; AT LEVEL 0 CAN'T POP ** .EJECT ** .ENDC ** ; ; SIMPLE RENAME PROGRAMME ; ; DEFINE THE STACK ONP= 1 PEND= ONP PEND RENAM: ISZ SSRTN,2 RENA1: C GETAR ; GET ARGUMENT (MUST BE IN PAIRS) RTRN ; NONE THERE OR LEFT STA 0,ONP,3 ; SAVE NAME POINTER C GETAR ; LOOK FOR NEXT JMP NOARG ; ARGS ARNT IN PAIRS - ERROR MOV 0,1 ; NEW NAME PTR IN AC1 LDA 0,ONP,3 ; OLD NAME PTR IN AC0 S RENAM ; RENAME JMP RNERR RENX: MOV 1,0 JMP RENA1 ; GO BACK NOARG: LDA 2,NRAD ; PRINT MESSAGE JMP ERRX RNERR: LDA 3,CERR SUB# 2,3,SNR ; WHICH FILE? MOV 1,0 ; NEW-NAME$ POINTER ER1 4 ; SEND ERROR TO PROPER PLACE JMP RENX ; NOT FATAL CONTINUE JMP FRTN NRAD: CNEAR CERR: ERCRE ; ; SIMPLE APPEND PROGRAM ; ICH= COMCH ** .DO CCOND OCH= PUSCH .ENDC J OCH= TMPCH **[J] ; DEFINE THE STACK BSIZ= 200 BP= 1 AP= BP+1 p TMP= AP+1 BUFF= TMP+1 STSIZ= BUFF+(BSIZ/2) STSIZ APPEND: ISZ SSRTN,2 ; SET GOOD RETURN BPT BUFF BP ; MAKE POINTER TO BUFFER C GETARG ; FIRST ARG IN TARGET FILE RTRN S CRAN ; CREATE TARGET FILE JMP CRERR SUB 1,1 S OPEN OCH JMP CRERR LOOP: C GETAR ; OTHER FILES JMP EDARG SUB 1,1 S OPEN ICH JMP OPER STA 0,AP,3 ; SAVE ARG PTR LDA 0,BP,3 ; BUFFER POINTER LDA 1,BCWT ; COUNT LOOP1: S RDS ICH JMP RDER S WRS OCH ; WRITE JMP WRER JMP LOOP1 ; GO READ AGAIN RDER: STA 1,TMP,3 ; SAVE COUNT LDA- 1,EOFCD ; LOOK FOR EOF SUB# 2,1,SZR JMP WRER LDA 1,TMP,3 S WRS OCH ; COMPLETE WRITE JMP WRER S CLOS ICH NOP LDA 0,AP,3 JMP LOOP EDARG: S CLOS OCH NOP RTRN BCWT: BSIZ EOFCD: EREOF ; ERROR HANDLING WRER: MOV 2,1 ; SAVE ERROR CODE IN AC1 S MzCLOS ICH NOP MOV 1,2 ; RESTORE ORIGINAL ERROR OPER: MOV 2,1 ; SAVE ERROR CODE IN AC1 S CLOS OCH NOP MOV 1,2 ; RESTORE ORIGINAL ERROR CRERR: ER1 4 ; REPORT THE ERROR RTRN FRTN: LDA 2,SSOSP,3 ; TAKE FATAL ERROR RETURN DSZ SSRTN,2 RTRN ERRX: ER2 3 RTRN JMP FRTN ; FATAL ERROR ; "DISK" COMMAND PROGRAM ; ; DEFINE THE STACK WC= 1 LFT= WC+1 LFT1= LFT+1 USD= LFT1+1 USD1= USD+1 MBLK= USD1+1 FSTAT= MBLK+1 MBP= FSTAT+UFDEL+1 MB= MBP+1 SIZ= MB+SCDBS SIZ SPACE: ISZ SSRTN,2 LDA 0,.MA ; OPEN "MAP.DR" LDA 1,FSTAD ADD 3,1 ; WORD ADDR OF FILE STAT SPACE S STAT JMP CRERR ISZ FSTAT+UFTBK,3 ; BUMP ONE FOR COUNTING CLER LFT LFT1 USD USD1 MBLK ; CLEAR COUNTS AND BLK NO. S ROPEN OCH JMP CRERR ; ERROR?! RDLP: INCS 1,2 ; MAKE 400 - BLOCK INCR LDA 1,MBLK,3 ; MAP.DR LOGICAL BLK# ISZ MBLK,3 LDA 0,MBAD ADD 3,0 ; WORD ADDR OF BLOCK BUFFER STA 0,MBP,3 S RDB OCH JMP TSEOF ; TEST FOR EOF DSZ FSTAT+UFTBK,3 ; COUNT BLOCKS IN FILE JMP .+3 ; NOT THERE YET LDA 0,FSTAT+UFTBC,3 ; LAST ONE - REVISE WORDS TO COUNT MOVZR 0,0,SKP ; BYTES -> WORDS LDA 0,BFC STA 0,WC,3 ; WORDS IN THIS BLOCK LP: LDA 0,@MBP,3 ISZ MBP,3 LDA 1,M20 ; COUNT ALL OF THEM LP1: MOVR 0,0,SZC ; FREE ? JMP LP2 ; NO BUMP USED ISZ LFT1,3 ; YES BUMP FREE JMP LP3 ISZ LFT,3 I_JMP LP3 LP2: ISZ USD1,3 ; BUMP USED JMP LP3 ISZ USD,3 LP3: INC 1,1,SZR ; ALL BITS DONE ?? JMP LP1 ; NO CONTINUE DSZ WC,3 JMP LP ; YES JMP RDLP ; TEST FOR EOF TSEOF: LDA 1,EOFCD ; AC1 <= EOF CODE SNE 1,2 ; WAS IT EOF? JMP SPOUT ; YES- WRITE !SPACE OUT LDA 0,.MA ; NO- POINT AC0 AT MAP.DR JMP OPER ; AND REPORT THE ERROR ; OUPUT DISK SPACE SPOUT: LDA 0,LINP ; POINT TO MESSAGE C WRLIN LFT LFT1 USD USD1 JMP EDARG ; THAT'S ALL M20: -20 .MA: MAPJ*2 LINP: .LINP*2 MBAD: MB BFC: SCDBS FSTAD: FSTAT ** .NOLOC 1 MAPJ: .TXT /MAP.DR/ .LINP: .TXT /LEFT: ^P USED: ^P<15>/ ** .NOLOC 0 ** .DO CCOND ; SQUASH NEW SYSTEM FILE 0 SQUASH: ISZ SSRTN,2 ; GOOD RETURN LDA 0,MSNSQ ; GET ADDRESS OF NONO MESSAGE C WRLIN ; WRITE IT OUT RTRN ; DONE IT MSNkSQ: .+1*2 ** .NOLOC 1 .TXT /SQUASH NOT NEEDED IN REV 5.00 OR LATER<15>/ ** .NOLOC 0 ** .EJECT ** ; INITIALIZE DIRECTORY, MAG TAPE, OR CASSETTE 0 INITC: C GETSW ; GET SWITCHES LDA 2,EFSW ; LOOK FOR "F" (FULL INIT) AND 2,1,SZR ADC 1,1 ; CODE -1 FOR FULL, 0 FOR PLAIN C GETAR ; GET ARG POINTER JMP @.NARG ; THERE MUST BE ONE S INIT JMP @.CRERR ; SOME ERROR RTRN EFSW: F.SW ; /F ; RELEASE A DIRECTORY/DEVICE RLERR= 1 ; PLACE FOR .RLSE ERROR CODE NEWDP= RLERR+1 ; POINTER TO NEW DIRECTORY NEWDN = NEWDP+1 ; PLACE FOR NEW DIRECTORY NAME STACK= NEWDN+UFTEX ; STACK LENGTH STACK RLSEC: ADC 1,1 ; INITIALIZE ERROR CODE STA 1,RLERR,3 ; = -1 C GETARG ; GET ARG POINTER JMP @.NARG S RLSE ; DO RELEASE STA 2,RLERR,3 ; SAVE ERROR CODE IN STACK =k BPT NEWDN NEWDP ; FORM BYTE POINTER TO NAME SPACE  MOV 1,0 ; AC0 => NAME SPACE S GDIR ; GET NAME OF CURRENT DIRECTORY NOP LDA 1,.CURDR ; AC1 => CURRENT DIRECTORY NAME C COMP ; HAS CURRENT DIRECTORY CHANGED? JMP CHKER ; NO- SEE IF ERROR OCCURRED LDA 0,.CURDR ; AC0 => CURRENT DIRECTORY LDA 1,.LSTDR ; AC1 => SPACE FOR PREVIOUS DIRECTORY C MOVE ; MAKE CURRENT = NEW DIRECTORY MOV 0,1 ; AC1 => SPACE FOR NEW DIRECTORY LDA 0,NEWDP,3 ; AC0 => NEW DIRECTORY NAME C MOVE ; MAKE CURRENT = NEW DIRECTORYy CHKER: LDA 1,RLERR,3 ; RESTORE POSSIBLE .RLSE ERROR CODE COM# 1,1,SNR ; ANY ERROR? RTRN ; NO- THAT'S ALL LDA 2,SSOSP,3 ; YES- RESTORE OLD STACK POINTER LDA 0,SSAC0,2 ; AND RESTORE POINTER C GETARG ; TO ARGUMENT NOP MOV 1,2 ; PUT ERROR CODE IN AC25 JMP @.CRERR ; AND REPORT IT .NARG: NOARG ; CHANGE THE CURRENT DEFAULT DIRECTORY NEWDP= 1 ; POINTER TO NEW DIRECTORY NEWDN= NEWDP+1 ; PLACE FOR NEW DIRECTORY NAME STACK= NEWDN+UFTEX ; STACK LENGTH STACK DIR: C GETARG ; GET ARG POINTER JMP @.NARbG ; NO ARGUMENT S DIR ; CHANGE THE DEFAULT DIRECTORY JMP @.CRERR ; ERROR- GO REPORT IT BPT NEWDN NEWDP ; FORM BYTE POINTER TO NAME SPACE MOV 1,0 ; AND PUT IT IN AC0 S GDIR ; READ IN NEW DIRECTORY NAME NOP LDA 0,.CURDR ; AC0 => CURRENT DIRECTORY  LDA 1,.LSTDR ; AC1 => SPACE FOR PREVIOUS DIRECTORY C MOVE ; MAKE PREVIOUS = CURRENT DIRECTORY MOV 0,1 ; AC1 => SPACE FOR CURRENT DIRECTORY LDA 0,NEWDP,3 ; AC0 => NEW DIRECTORY NAME C MOVE ; MAKE CURRENT = NEW DIRECTORY RTRN .CRERR: CRERR .CURDR: 9CURDR .LSTDR: LSTDR ** .EJECT ** ; SET TIME OF DAY / DAY OF YEAR ; INPUT: H?M?S [D?M?Y] WHERE ? IS ANY NONDIGIT(S) CP= 1 ORIG= CP+1 ARGP= ORIG+1 YEAR= ARGP+1 SCND= YEAR DAY= YEAR+1 MN= DAY MONTH= DAY+1 HR= MONTH MONTH STOD: SUBO 1,1 ; SET TIME OF DAY JMP SDAY+1 MONTH SDAY: SUBZL 1,1 ; SET DAY OF YEAR STA 1,ORIG,3 CLER MONTH,DAY,YEAR LDA 2,ARGD ADD 3,2 ; PTR TO TIME STORAGE STA 2,ARGP,3 LDA 2,CM3 ; EXPECT THREE NUMBERS SDAY1: C GETARG JMP SDAY2 ; NO INPUT? C .ASCDB ; CHANGE ASCII )TO DECIMAL JMP @.CRERR STA 1,@ARGP,3 DSZ ARGP,3 INC 2,2,SZR JMP SDAY1 SDAY2: DSZ ORIG,3 JMP STOD1 LDA 0,DAY,3 LDA 1,MONTH,3 LDA 2,YEAR,3 LDA 3,BASYR ; SUBTRACT BASE YEAR 1968. SUBZ 3,2,SZC JMP .+3 LDA 3,CENT ; MUST BE TWO DIGIT ADD 3,2 ; RESTORE CENTURY S SDAY JMP @.ERRX RTRN STOD1: LDA 0,SCND,3 LDA 1,MN,3 LDA 2,HR,3 ; MIN S STOD JMP ERC RTRN ** .ENDC ** CM3: -3 BASYR: 1968. CENT: 1900. ARGD: MONTH .ERRX: ERRX ; GET TOD AND TYPE OUT HOUR=1 MIN=2 SEC=3 ** .DO BCOND YEAR= 4 MONTH= 5 DAY= 6 CHN= DAY+1 ** .ENDC T CHN=MONTH+1 ** [T] CHN ** .DO CCOND GTOD: SUBZL 1,1 ; CONSOLE DEV OUTPUT CHANNEL# JMP GTODC ** .ENDC T GTOD: LDA 1,SCD JMP GTODC CHN GTCH: LDA 1,LCD JMP GTODC ** [T] CHN GTODC: ISZ SSRTN,2 STA 1,CHN,3 S GDAY JMP @.ERRX STA 0,DAY,3 STA 1,MONTH,3 LDA 1,BFYR ADD 1,2 STA 2,YEAR,3 S GTOD ; GET FROM SYSTEM JMP @.ERRX STA 2,HOUR,3 STA 1,MIN,3 STA 0,SEC,3 LDA 1,CHN,3 ; OUTPUT CHANNEL LDA 0,TIMSG C WRLCH MONTH DAY YEAR HOUR MIN SEC RTRN BFYR: 68. TIMSG: .+1*2 ** .NOLOC 1 .TXT *^D^Z<2>/^D^Z<2>/^D^Z<2> ^D^Z<2>:^D^Z<2>:^D^Z<2><15>* ** .NOLOC 0 NARG: NOARG ** .DO BCOND OLP: .+1*2 OLX: .TXT /.OL/ SCD: SOUT LCD: LOGCH ** .ENDC T ERC: ER2 4 RTRN ** [T] ** .DO CCOND ; SPOOLER COMMANDS 0 SPEBL: ADC 1,1 JMP SPL 0 SPKIL: SUBO 1,1 JMP SPL 0 SPDIS: SUBZL 1,1 SPL: C GETARG JMP @NARG JMP .FX AGAIN: C GETARG RTRN .FX: MOV# 1,1,SNR JMP KIL MOVR# 1,1,SNR JMP DIS S SPEA ; ENABLE SPOOLER JMP @.BOOER JMP AGAIN KIL: S SPKL ; KILL SPOOLEJ .OL LDA 2,SVND ; MAKE PTR TO .SV NAME BUFFER ADDZL 3,2 C MKNAM ; MAKE NAME.OL MOV 2,0 LDA 1,STP ADD 3,1 ; ADDR OF BUFFER FOR STATUS INFO S STAT ; VERIFY FILE EXISTS JMP RPER ; PROBLEM - STOP RIGHT NOW STA 0,NTMP,3 ; KEEP OL NAME PTR LDA 2,ORND ; MAKE PTR OTO .OR NAME BUFFER ADDZL 3,2 LDA 1,ORXP ; -> .OR C MKNAM ; MAKE NAME.OR MOV  r2,0 LDA 1,STP ADD 3,1 ; STATUS SPACE ADDRESS S RSTAT ; VERIFY THAT HE LIVES JMP RPER LDA 1,NTMP,3 ; -> NAME.OL S OVRP ; GO PLUG THEM IN JMP RPER LDA 0,CP,3 ; RELOAD COMMAND PTR JMP REPLAC ; TRY FOR ANOTHER ONE OLXP: .+1*2 .TXT /.OL/ ORXP: .+1;*2 .TXT /.OR/ SVND: SVNBF ORND: ORNBF STP: STSP RPER: JMP @.+1 CRERR NOA: NOARG ** .DO BCOND DPNT=1  1 RLSEC: ISZ SSRTN,2 C GETARG ; GET ARG POINTER JMP @NARG LDA 1,DBAS STA 1,DPNT,3 LDA 2,CMD ; COUNT POOL: LDA @1,DPNT,3 ; B.P. TO ENTRY IN DEV0EICE TABLE C COMP ; MATCH RELEASED NAME? JMP MATCH ; YES ISZ DPNT,3 ; NO - ADVANCE PTR INC 2,2,SZR ; DONE YET? JMP POOL ; NOPE LDA 2,DNER ; CAN'T FIND IT JMP ERC MATCH: .SYST ; FOUND DEVICE IN TABLE .RLSE ; RELEASE IT JMP ERC LDA 0,.DSMS ; "DI'SMOUNT" LDA 2,OPNUM ; CHANNEL NUMBER S WRL CPU ; WRITE IT JMP ERC ; OOPS LDA @1,DPNT,3 ; RECOVER THE POINTER LDA 0,C10. ADD 1,0 ; MAKE B.P. TO PHYSICAL DEVICE NAME S WRL CPU ; TELL THE OP JMP ERC LDA @0,DPNT,3 ; GET THE FIRST POINTER AGAIN SUB 1,1 ; FIND ZERO C STBT ; FREE THE NAME STORAGE RTRN DBAS: .D1 DNER: ERDNM OPNUM: OPOUT CMD: MDCNT .DSMS: BDSMS C10.: 10. .EJECT ** DDIR=1 DSIZ=DDIR+10 DPTR=DSIZ+1 DPTR DIR: ISZ SSRTN,2 C GETARG JMP @NARG S DIR JMP ERC LDA 1,PMDIR C COMP  RTRN MOV 1,0 LDA 1,DPTD ADDZL 3,1 ; MAKE A B.P. TO TEMP SPACE STA 1,DPTR,3 ; AND REMEMBER IT LDA 0,PMDIR ; MASTER DIRECTORY NAME C MOVE ; MOVE DIR NAME TO TEMP MOV 1,0 LDA 1,COL ; GET A COLON C STBT ; AND PUT AT END INC 0,1 ; NEXT BYTE LDA 0,SOT ; "SYSOUT" C MOVE ; APPEND TO DIRECTORY NAME MOV 1,0 ; NEXT BYTE SUB 1,1 ; GET A NULL C STBT ; AND STORE IT LDA 0,SOT ; "SYSOUT" S ULNK NOP LDA 1,DPTR,3 ; HAS MASTER DIRECTORY NAME S LINK ; LINK TO MASTER SYSOUT LINK JMP ERC RTRN DPTD<: DDIR PMDIR: BMDIR EROP2: EOP2 COL: ": SOT: .+1*2 .TXT /SYSOUT/ ERC: ER1 2 ; SEND ERROR TO PROPER PLACE RTRN ; TAKE NORMAL RETURN LDA 2,SSOSP,3 DSZ SSRTN,2 RTRN ** .EJECT ** .ENDC ** ; ;THIS COMMAND WILL EXAMINE THE INPUT FOR A FILENAME ;THE NAMEI WILL BE CHECKED FOR A .SV ,EXIST IN THE CURRENT DIR, ;HAS A REV NUMBER ; ; DEFINE THE STACK TMP= 1 ; TEMP STORAGE RCODP= TMP+1 ; POINTER TO WORD STORAGE RCOD= RCODP+1 ; WORD FOR REV NUMBER MIN= RCOD+1 ; MINOR REV CODE MAJ= MIN+1 ; MAJOR REV CODE OeTHRP= MAJ+1 ; POINTER TO OTHER INFO OTHER= OTHRP+1 ; OTHER INFORMATION NP= OTHER+6 ; BYTE POINTER TO NAME NAME= NP+1 STAK= NAME+30 ICH= COMCH STAK REVNO: ISZ SSRTN,2 ; BUMP RETURN C GETARG JMP @NOA ; NO SOURCE FILE SPCIFIED LDA 2,NAMED ADDGhZL 3,2 ; BYTE POINTER TO PLACE TO STORE NAME STA 2,NP,3 LDA 1,.SVP ; AC1 => .SV C VRFIL ; SEE IF IT EXISTS JMP @.EOUT ; NO GIVE ERROR MOV 2,0 ; MOVE COMPOSIT NAME TO AC0 S ROPEN ICH JMP @.EOUT S GTATR ICH JMP LSER LDA 1,TATSV ; CHECK IF THIS FILE IS A .SV AND# 0,1,SNR JMP @.AERR ; NOPE STOP RIGHT HERE ; LOCATE UST FOR THIS TYPE PROGRAM BPT RCOD RCODP ; FORM BYTE POINTER TO REV NUMBER SUB 0,0 ; CLEAR MSH FOR SPOS CALL LDA 1,.SAUST ; AC1 => STAND ALONE USTPC STA 1,TMP,3 ; AND SAVE POINTEήR IN STACK S SPOS ICH ; POSITION TO FILE WORD 400 JMP LSER ; BAD NEWS !!!! LDA 0,RCODP,3 ; AC0 => PLACE TO STORE USTPC LDA 1,C2 ; AC1 = BYTE COUNT (ONE WORD) S RDS ICH ; READ IN POSSIBLE USTPC JMP LSER ; BAD NEWS !!! LDA 0,RCOD,3 ; PICK UP POSSIBLE USTPC MOV# 0,0,SZR ; IF NOT = 0 THEN THIS MUST BE JMP RDBGD ; USTFC OF BGND RDOS SAVE FILE LDA 1,.SANM ; ELSE CHECK IF STAND ALONE USTNM S SPOS ICH ; POSITION TO FILE WORD 404 JMP LSER ; BAD NEWS !!! LDA 0,RCODP,3 ; AC0 => PLACE TO STORE NMAX LDA 1,tC2 ; AC1 = BYTE COUNT (ONE WORD) S RDS ICH ; READ POSSIBLE STAND ALONE NMAX JMP LSER ; BAD NEWS !!!! LDA 0,RCOD,3 ; PICK UP POSSIBLE NMAX- MOV# 0,0,SZR ; IF IT IS NON-ZERO IT IS NMAX JMP SALON ; OF A STAND ALONE PROGRAM RDBGD: SUB 0,0 ; ELSE THIS IS %RDOS SAVE FILE LDA 1,.RDUST ; AC1 => RDOS USTPC STA 1,TMP,3 ; SAVE POINTER IN STACK S SPOS ICH ; POSITION TO FILE WORD 362 JMP LSER ; BAD NEWS !!!! LDA 0,RCODP,3 ; AC0 => PLACE TO STORE USTPC LDA 1,C2 ; AC1 = BYTE COUNT (ONE WORD) S RDS ICH ; READ RkDOS USTPC JMP LSER ; BAD NEWS !!! LDA 0,RCOD,3 ; AC0 <= USTPC MOVZL 0,0,SNR ; IF = 0 JMP SALON ; THEN HAVE BACKGROUND UST LDA 1,.SCSTR ; ELSE HAVE FOREROUND UST SUB 1,0,SKP ; SO ADJUST UST POINTER ; READ IN REV NUMBER FROM UST SALON: LDA 0,TMP,3 ; 3 AC0 =>UST LDA 1,REN1 ; AC1 <= LOC OF REVNUM ADDZ 0,1 ; FORM BYTE POINTER SUBCL 0,0 ; CATCH OVERFLOW IF ANY S SPOS ICH ; POSITION TO USTRV IN FILE JMP LSER ; BAD NEWS!!! LDA 0,RCODP,3 ; AC0 => REV NUMBER WORD LDA 1,C2 ; BYTE TO BE READ S RDS ICH ;  READ IN REV NUMBER JMP LSER ; BAD NEWS !!!! LDA 2,RCOD,3 ; IF -1 THEN FILE HAS NO REV NUM COM# 2,2,SNR SUB 2,2 ; ALWAYS HAVE ONE STA 2,RCOD,3 ; SAVE IT IN THE STACK ; NOW WRITE OUT REV NUMBER BPT OTHER OTHRP ; FORM BYTE POINTER TO OTHER INFO LDA 0,LMASK ; AC0 <= LEFT HALF MASK ANDS 0,2 ; AC2 <= MAJOR REV CODE LDA 0,.OIFLG ; AC0 <= OTHER INFO FLAG AND# 0,2,SNR ; IS "PRE-RELEASE" FLAG SET? JMP NOPRE ; NO- NOTHING SPECIAL TO DO COM 0,0 ; YES- SET MASK TO STRIP OFF BIT AND 0,2 ; AND STRIP IT !!! LDA 0,.PR ; AC0 => "PR" MESSAGE C MOVE ; MOVE IT IN NOPRE: LDA 0,K99 ; IF REV NUMBER IS SUBZ# 2,0,SNC ; GREATER THAN 99 THEN MOV 0,2 ; SET IT EQUAL TO 99 STA 2,MAJ,3 ; ELSE JUST STORE WHAT IT IS. LDA 2,RCOD,3 ; NOW EXTRACT MINOR REV CODE LDA 0r,LMASK ; PICK UP LEFT HALF MASK MOVS 0,0 ; AND MAKE IT RIGHT HALF MASK AND 0,2 ; AC2 <= MINOR REV CODE LDA 0,.OIFLG ; AC0 <= OTHER INFO FLAG AND# 0,2,SNR ; IS "PATCHED" BIT SET? JMP NOPAT ; NO- NOTHING SPECIAL TO DO COM 0,0 ; YES- SET MASK TO STRIP4 OFF BIT AND 0,2 ; AND STRIP IT LDA 0,.PATCH ; AC0 => "PATCHED" MESSAGE C MOVE ; AND MOVE IT IN NOPAT: LDA 0,K99 ; IF MINOR REV IS SUBZ# 2,0,SNC ; GREATER THAN 99 THEN MOV 0,2 ; SET IF EQUAL TO 99 STA 2,MIN,3 ; ELSE JUST STORE WHAT IT IS. LDA 0,.CR ; AC0 => C/R C MOVE ; FINISH OFF WITH C/R LDA 0,LOUT ; FORMAT LINE C WRLIN ; WRITE OUT REV MESSAGE NP ; NAME MAJ ; MAJOR REV MIN ; MINOR REV OTHRP ; OTHER INFORMATION ENDO: S CLOS ICH ; CLOSE UP NOP RTRN NAMED: NAME .EOUT: EOUT .SVP: .+1*2 ** .NOLOC 1 .TXT *.SV* ** .NOLOC 0 TATSV: ATSAV ; SAVE FILE ATTRIBUTE .SAUST: UST+USTPC*2 C2: 2 .SANM: UST+USTNM*2 .AERR: AERR ; HANDLE ERRORS LSER: ER2 3 JMP ENDO ..FRTN: LDA 3,SSOSP,3 ; SET ERROR RETURN DSZ SSRTN,3 JMP ENDO AERR: LDA 2,NSVF| ; NOT A .SV EOUT: LDA 0,NP,3 ER1 3 JMP ENDO JMP ..FRTN .RDUST: UST+USTPC-SCSTR*2 LOUT: .+1*2 ** .NOLOC 1 .TXT /^C^T<20>^D^Z<2>.^D^Z<2>^C/ .PATCH: .+1*2 .TXT * PATCHED* .PR: .+1*2 .TXT *PR* .CR: .+1*2 .TXT *<15>* ** .NOLOC 0 NEAR: CNEAR ; CLI ERROR EXCOD: ERDLE ; FILE DOES NOT EXEIST LMASK: 377*400 ; MASK FOR LEFT HAND SIDE NSVF: ERSV1 ; FILE SPECIFIED IS NOT A .SV .SCSTR: SCSTR*2 REN1: USTRV*2 .OIFLG: 1B8 K99: 99. DUMP.SR5 Q3 ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CDUMP .RB CDUMP.RB ** .ENDC J .TITL BDUMP .RB BDUMP.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT DUMP RDSIN RDSYS SNTU[N CMPNM .EXTN COMP ; COMPARE STRINGS .EXTN GETAR ; GET ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN SETSW ; SET SWITCH ROUTINE .EXTN BFMVI ; BUFFER MOVE LINE IN .EXTN PCBUF ; PUT CHARACTER BUFFER .EXTN SBUFR ; SCRATCH BUFFER .EXTN CLBUF ; CLEAR BUFFDER ROUTINE .EXTN LDBT STBT .EXTN LDBI STBI .EXTN CALL RTRN RCALL .EXTN WRBIN .EXTN CMOVE .EXTN .INDEX INDEX .EXTN .ASCD ; ASCII TO DECIMAL CONVERSION .EXTN DUM2E ; DUMP PART 2 OVERLAY NUMBER .EXTN DUM2 ; DUMP PART 2 ENTRY ADDRESS .EXTN SWAPR ; SW AP OVERLAY ROUTINE ; DEFINE THE STACK ASW= 1 ; ALL SWITCH KSW= ASW+1 ; NO LINK SWITCH SSW= KSW+1 ; SEGMENTED TAPE SWITCH CP= SSW+1 ; ARG POINTER STACK= CP ; STACK SIZE STACK DUMP: ISZ SSRTN,2 ; SET GOOD RETURN C GETSW ; GET THE SWITCHES STA 0,,CP,3 ; SAVE POINTER SW A K S ; TEST SWITCHES LDA 0,CP,3 C GETAR ; GET OUTPUT FILE NAME JMP NOARG ; MUST HAVE OUTPUT FILE STA 0,CP,3 ; SAVE POINTER SNZ SSW ; IF NOT DOIN SEGMENTED TAPE THEN JMP D2 ; MAKE LIKE WE KNOW WHAT WE IS UP TO ELSE LDA 1,DPER ; CHECK IF SEGMENTED TAPE FILE HAS EXTENSION C INDEX ; IF IT DOSN'T, THEN ASSUME IS DEVICE JMP D4 ; AND GO OPEN IT INC 0,0 ; INC TO EXTENSION LDA 1,.XX ; GET POINTER TO EXTENSION LOOKED FOR C COMP ; IF GOT IT THEN MOV# 0,0,SKP ; SKIP ELSE JMP I.LDNM ; ILLEGAL FILE NAME LDA 1,ZERO ; PUT ON EXTENSION OF C STBI ; ".01" INC 1,1 C STBT LDA 0,CP,3 ; RESTORE POINTER TO FILE NAME D2: S CRAND ; CREATE OUTPUT FILE JMP DUMER ; MUST BE ABLE TO CREATE IT D4: LDA 0,CP,3 ADC 1,1 ; OPEN FILE TO GET A:TTRIBUTES S OPEN COMCH JMP DUMER ; GOOD GRIEF S GTAT COMCH ; GET ATTRIBUTES JMP DUMER S CLOS COMCH ; CLOSE IT AGAIN JMP DUMER LDA 2,.ATWPR AND 0,2,SZR ; WRITE PROTECTED ?? JMP WRITP ; YES TELL HIM NOW !! LDA 2,MOSBP ; CLEAR OUT NAME BUFFER C CLBUF SUB 0,0 SNZ ASW ; PERM FILES ? LDA 0,PERAT ; NO MASK THEM OUT SUB 2,2 SKZ KSW ; LINKS ?? LDA 2,LINAT ; NO MASK THEM OUT ADD 2,0 MOV 0,1 ; AC1 = INHIBIT MASK ADC 2,2 ; ANYTHING ELSE OK LDA 0,CP,3 ; AC0= ARG POINTER C MKNMS ; MAKE THE gHIT LIST JMP FERTN ; TAKE ERROR RETURN LDA 2,SSOSP,3 ; TRAP TO SECOND HALF OF DUMP ROUTINE LDA 0,DUMOV ; AC0 = DUM2 OVERLAY NUMBER STA 0,SSAC0,2 ; STORE IT LDA 0,DUM2A ; AC2 = DUM2 ADDRESS STA 0,SSAC2,2 LDA 0,.SWAP ; TRAP TO SWAP ROUTINE STA 0,SSRTqN,2 RTRN DPER: ". .XX: .+1*2 .TXT /XX/ ZERO: "0 .ILNM: ERFNM DUMOV: DUM2E ; OVERLAY # AND NODE DUM2A: DUM2 ; ENTRY ADDRESS .SWAP: SWAPR MOSBP: SBUFR ; POINTER TO SBUFF HEADER PERAT: ATPER LINAT: ATLNK .ATWPR: ATWP WPRER: ERWPR ILDNM: LDA 2,.ILNM JA%MP DUMER WRITP: LDA 2,WPRER ; GIVE WRITE PROTECT ERROR JMP DUMER ; BAG IT NOARG: LDA 2,ERARG DUMER: LDA 0,CP,3 ; GET PROPER ARG ER1 3 NOP FERTN: LDA 3,SSOSP,3 ; TAKE ERROR RETURN DSZ SSRTN,3 S CLOS COMCH ; CLOSE FILE JUST IN CASE RTRN RTRN ERARG: CNEAR ; DEFINE THE STACK ARGSW= 1 ; ARGUMENT SEEN SWITCH ASW= ARGSW+1 ; ATTRIBUTES TO IGNORE OSW= ASW+1 ; ATTRIBUTES TO LOOK FOR SSW= OSW+1 ; LOCAL/S SWITCH IP= SSW+1 ; INPUT POINTER DSEEN= IP+1 ; DIRECTORY SEEN SWITCH RECS= DSEEN+1 ; REC SWITCHL ADATE= RECS+1 ; AFTER DATE BDATE= ADATE+1 ; BEFORE DATE NAMEP= BDATE+1 ; POINTER TO NAME BP= NAMEP+1 ; POINTER TO BUFF NAME= BP+1 ; SPACE FOR FILE NAMES BUFH= NAME+12 ; BUFFER HEADER ADDRESS BUFF= BUFH+2 ; BUFFER ADDRESS STACK= BUFF+401; STACK SIZE ** .DO CCOND SYSCH= PUSCH ** .ENDC J SYSCH= TMPCH **[J] BP MKNMS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN STA 0,IP,3 ; SAVE INPUT POINTER STA 1,ASW,3 ; SAVE ATTRIBUTES OFF WORD LDA 2,SSAC2,2 ; SAVE ATTRIBUTES ON WORD STA 2,OSW,3 ADC 1,1 STA 1,BDATE,3 ; BEFORE TIME = END OF TIME STA 1,ARGSW,3 ; SET NO ARGUMENT FLAG CLER ADATE ; AFTER DATE = 0 STA 1,RECS,3 ; RECS = 0 STA 1,DSEEN,3 ; DSEEN = 0 MKNM0: STA 1,BP,3 ; SET/RESET ARG FLAG MKNM1: C GETAR ; GET NEXT ARGUMENT JMP MKNP2 ; NONE LEFT GO TO! NEXT PASS C GETSW ; GET SWITCHES STA 2,SSW,3 ; SAVE SECOND SWITCH WORD MOVZL 1,1,SZC ; /A ? JMP AFTER ; YES PROCESS AFTER DATE MOVZL 1,1,SZC ; /B ? JMP BEFOR ; YES PROCESS BEFORE DATE LDA 3,K20 ; /N ?? AND# 3,1,SZR JMP MKNM1 ; YES DON'T ADD -TO LIST C TDASH ; ARG HAVE - OR * ? JMP MKNM5 ; YES - SEE ABOUT S SWITCH ADC 1,1 C TDIR ; DIRECTOR OF PARTITION ? JMP MKNM6 ; YES FORCE SYS.DR SEARCH LDA 2,.SBUFR ; NO ADD NAME TO BUFFER C BFMVI ISZ BFFFB,2 ; COUNT NULL LDA 1,SWUS ; MARK EiNTRY USED C SETSW CLER ARGSW ; SHOW WE HAD AT LEAST ONE ARGUMENT LDA 1,KSWN ; NOW MARK NAME FOR SYS.DR SEARCH C SETSW LDA 1,SSW,3 LDA 3,SS.W AND# 1,3,SNR ; /S LOCAL ?? JMP MKNM1 ; NO PROCESS NEXT ARGUMENT DSZ BFFFB,2 ; YES - CHANGE TRAILING NUMLL TO SPACE LDA 1,K40 C PCBUF C GETAR ; YES GET NEXT ARG JMP @.MKNNA ; ERROR MUST BE IN PAIRS C TDASH ; TEST FOR - OR * JMP MKNME ; NO - OR * ALLOWED HERE C BFMVI ; ALL APPEARS TO BE OK PUT ARG AWAY ISZ BFFFB,2 ; COUNT NULL MKNM4: LDA 1,KSWI ;7 KILL THIS ARG IN LIST C SETSW ; BY SETTING INVISABLE SWITCH JMP MKNM1 ; GET NEXT MKNM5: LDA 2,SSW,3 ; ARG HAD A - OR * LDA 1,SS.W AND# 1,2,SNR ; /S SET ? JMP MKNM0 ; NO COUNT THIS ARG AND CONTINUE MKNME: LDA 2,MNCIL ; YES - FLAG AS ILLEGAL ARGU9MENT JMP @.MKEER ; BAIL OUT MKNM6: STA 1,DSEEN,3 ; SHOW DIRECTORY SEEN CLER ARGSW ; SHOW WE HAD AT LEAST ONE ARG JMP MKNM1 ; CONTINUE AFTER: C CNVRT ; CONVERT DAYS SICE 68 JMP @.FATER ; SOME TYPE OF ERROR STA 1,ADATE,3 JMP MKNM4 BEFOR: C CNVRT ;It CONVERT TO DAYS SINCE 68 JMP @.FATER ; TRY AGAIN STA 1,BDATE,3 ; SAVE IT JMP MKNM4 ; CONTINUE SS.W: S.SW KSWN: 3B7+N.SW ; SWITCH WORD TWO, BIT 13 KSWI: 3B7+1 ; SWITCH WORD TWO, BIT 15 K20: 20 K40: 40 .SBUFR: SBUFR .MKNNA: MKNNA MNCIL: CILAR .MKEER: MKEER .FATER: FATER ; NOW PROCESS NORMAL ARGUMENTS MKNP2: LDA 1,ARGSW,3 LDA 0,BP,3 LDA 2,DSEEN,3 ; DIRECTORY FLAG MOV 0,0,SZR ; ANY - OR * ARGS SUB 1,1 ; YES DON'T WANT FORCE SWITCH STA 1,ARGSW,3 MOV 2,2,SNR ADD 0,1,SZR ; NEED A SYS.DR SEARCH ? JMP MKNP3 ; YES ON WITH IT JMP NOARL ; NO TAKE A SHORT CUT MKNP3: C FIND ; DO SYS.DR LOOKUP JMP FATER ; BAD NEWS RTRN ; ALL DONE SWUS: 3B7+2 STACK FINDR: ISZ SSRTN,2 ; ENTRY FOR SUBDIRECTORIES C CARGS ; COPY ARGS STA 2,ARGSW,3 ; FORCE ALxL MATCH JMP FIND1 STACK FIND: ISZ SSRTN,2 C CARGS ; COPY ARGUMENTS FIND1: BPT NAME NAMEP ; MAKE POINTER TO NAME SPACE BPT BUFF BP ; AND BUFFER MOV 1,0 ; SET UP POINTERS LDA 1,.SYSCH C RDSIN ; OPEN UP SYS.DR JMP SYSER ; ;;;; FINI1: LDA 0,BP,3 ;R GET FIRST ENTRY C RDSYS JMP REDER ; MAY BE END OF FILE STA 2,SSW,3 ; SAVE POINTER TO ENTRY LDA 0,ASW,3 ; CHECK FOR ATTRIBUTS MASK LDA 1,UFTAT,2 AND 1,0,SZR ; IF ANY OF THEM ON SKIP THIS ENTRY JMP FINI1 LDA 0,OSW,3 ; TEST ATTRIBUTES ON WORD COM# 00n,0,SNR ; ALL CASE ?? MOV 0,1 ; YES INSURE A MATCH AND 1,0,SNR ; AT LEASE ONE OF THEM ON ?? JMP FINI1 ; NO SKIP THIS FILE MOVZL 2,0 ; SET POINTER LDA 1,ARGSW,3 ; ARGUMENT FLAG C CNAME ; NAME MATCH ?? JMP FINI1 ; NO TRY NEXT LDA 0,UFTAT,2 LDA 1,FN{OTI AND# 1,0,SZR ; A LINK DIRECTORY OR PARTITION ?? JMP FIND2 ; YES - THEY HAVE NO TIME LDA 0,UFTYD,2 LDA 1,ADATE,3 SUBZ# 1,0,SNC ; TOO OLD ? JMP FINI1 ; YES SKIP IT LDA 1,BDATE,3 SUBZ# 1,0,SZC ; TOO YOUNG ? JMP FINI1 ; YES FORGET IT ALSO FIND2: LDA 0,NAMEP,3 C SNTUN LDA 2,.SBUFR C BFMVI ISZ BFFFB,2 ; COUNT FINAL NULL LDA 2,SSW,3 LDA 0,UFTAT,2 LDA 1,MNDIP AND# 1,0,SZR ; DIRECTORY OR PARTITION ? JMP MNDIR ; YES GO PROCESS IT JMP FINI1 ; CONTINUE REDER: LDA 3,KEOF SUB# 3,2,SZR ; EbND OF FILE ?? JMP SYSER ; NO TOO BAD S CLOS SYSCH ; YES CLOS SYS.DR CHANNEL NOP NOARL: LDA 1,K200 ; STORE TERMINATOR LDA 2,.SBUFR C PCBUF SUB 1,1 ; STORE A NULL C PCBUF SKZ RECS ; PUSHED ?? RTRN ; YES JUST RETURN LDA 0,IP,3 ; RESTORE ARG POINTER ENDE1: C GETAR ; GET NEXT ARGUMENT RTRN ; ALL FINISHED C GETSW ; GET SWITCHES MOVZR 2,2 MOVZR 2,2,SZC ; USED ?? JMP ENDE1 ; YES GET NEXT LDA 2,.CSPER ; GIVE ERROR ER1 4 JMP ENDE1 ; CONTINUE JMP FATER ; SORRY ABOUT THAT K200: 200 FNOTI5: ATLNK+ATDIR+ATPAR .SYSCH: SYSCH KEOF: EREOF .CSPER: CSPER MSSYS: DIRN*2 MKNMA: CNEAR MNDIP: ATDIR+ATPAR MKNNA: LDA 2,MKNMA ; NOT ENOUGH ARGENMENTS JMP MKEER SYSER: LDA 0,MSSYS ; REPORT SYS.DR ERROR MKEER: ER1 1 JMP FATER FATER: LDA 3,SSOSP,3 ; WHOA DSZ SSRTN,3 S CLOS SYSCH ; CLOSE SYS.DR CHANNEL NOP RTRN MNDIR: LDA 0,NAMEP,3 ; FIND OUT WHERE WE ARE S GDIR JMP MKEER ; SHOULD NEVER HAPPEN LDA 1,RECS,3 ; SHOW WE ARE PUSHING MOVOL 1,1 ; SHOW WE ARE PUSHING MOVZL 1,1 STA 1,RECS,3 S CLOS SYSCH "; CLOSE SYS.DR JMP SYSER ; GOOD GRIEF MOVZL 2,0 ; POINT TO DIRECTORY NAME SUB 1,1 STA 1,UFTEX,2 ; WIPE OUT THE EXTENTION S INIT ; INIT NEW DIRECTORY JMP MNDIE ; MAY BE OK MNDI1: S DIR ; DIR TO IT JMP MKEER ; NOT OK C FINDR ; CALL THIS MESS AGAINX4 JMP FATER ; BAD BAD BAD ! ! ! LDA 0,NAMEP,3 ; DIR BACK TO WHERE WE WERE S DIR JMP MKEER ; THIS CAN'T BE HAPENING LDA 1,RECS,3 MOVZR 1,1,SZC ; WAS DIRECTORY INITED ? JMP MNDI2 ; YES LEAVE IT THAT WAY LDA 0,SSW,3 ; NO RELEASE IT MOVZL 0,0 ; MAKiE IT BYTE POINTER S RLSE JMP MKEER ; WHAT WAS INITED MUST BE RELEASED MNDI2: MOVZR 1,1 STA 1,RECS,3 ; RESET REC SWITCH LDA 0,MSSYS ; REOPEN SYS.DR SUB 1,1 S OPEN SYSCH JMP SYSER ; WE HAD IT ONCE UPON A TIME JMP @MNDIX ; CONTINUE WHERE WE LEFT OFF MLNDIX: FINI1 MNDIE: LDA 1,MERIBS SUB# 1,2,SZR ; DEVICE ALREADY IN SYSTEM JMP MKEER ; NO - ANYTHING ELSE IT FATAL ISZ RECS,3 ; REMEMBER IT JMP MNDI1 MERIBS: ERIBS TMP= 1 ; TEMP NAMP= TMP+1 ; POINTER TO SYSTEM NAME HIT= NAMP+1 ; HIT FLAG NOTF= HIT+1 ; NOT FLAG (/N) STACK= NOTF ; STACK LENGTH STACK CNAME: STA 0,NAMP,3 ; SAVE POINTER TO SYS.DR ENTRY STA 1,HIT,3 ; SET/RESET HIT SWITCH LDA 1,RECS,2 ; COPY RECS TO MY TMP STA 1,TMP,3 CLER NOTF ; CLEAR NOT FLAG LDA 0,IP,2 ; GET ARGUMENT POINTER CNAM1: C GETAR ; GET AN ARGUMENT JMP CNAM2 ; END OF LIST GO TEST LDA 1,NAMP,3 ; COMPARE NAME C CMPNM JMP CNAM1 ; NO MATCH TRY NEXT STA 1,HIT,3 ; MARK THE HIT SKZ TMP,3 ; IN DIRECTORY ?? JMP CNAM4 ; YES IGNORE EXPLICIT NAME FLAG C GETSW ; GE!T SWITCHES LDA 1,KNSW ; IS IT SET ? AND# 1,2,SZR ; WELL . . ?? STA 1,NOTF,3 ; YES MARK IT NOT CNAM4: C GETSW ; GET SWITCHES LDA 2,KNSW AND# 2,1,SZR ; /N ?? STA 2,NOTF,3 ; YES SET NOT FLAG LDA 1,CSWUS ; MARK IT USED C SETSW JMP CNAM1 ; GET NEXzT CNAM2: LDA 0,CNSYS ; MAKE SURE NOT SYS.DR OR MAP.DR LDA 1,NAMP,3 C CMPNM ; SYS.DR ?? JMP CNAMT ; NO TRY MAP.DR STA 1,NOTF,3 ; YES - ITS A NOT CNAMT: LDA 0,CNMAP C CMPNM ; IS IT MAP.DR JMP CNAM3 ; NO CONTINUE STA 1,NOTF,3 ; YES OUT IT GOKES CNAM3: LDA 1,HIT,3 LDA 0,NOTF,3 MOV 0,0,SNR ; IF NOT GIVE NO MATCH RETURN MOV 1,1,SNR ; IF NO MATCH GIVE NO MATCH RETURN RTRN LDA 2,SSOSP,3 ; RESTORE SSOSP ISZ SSRTN,2 ; ELSE GIVE GOOD RETURN RTRN CSWUS: 3B7+2 KNSW: N.SW CNSYS: DIRN*2 CNMAP: MAB!PN*2 MAPN: .TXT *MAP.DR* ;TDASH ; ROUTINE TO TEST ARGUMENT FOR - OR * ; ; CALLING SEQUENSE ; LDA 0,(BYTE POINTER TO NAME) ; C TDASH ; (FOUND RETURN) ; FOUND * OR - ; (NOT FOUND RETURN) 0 TDASH: LDA 1,TDDAS C .INDEX ; A DASH ? JMP TDAS1 ; NO - իTRY FOR STAR RTRN ; YES - RETURN TDAS1: LDA 1,TDSTA C .INDEX ; A STAR ? ISZ SSRTN,2 ; NO MATCH BUMP RETURN RTRN TDDAS: "- TDSTA: "* ;TDIR ; TEST FILE NAME IN AC0 TO SEE IF IT IS A DIRECTORY OR PARTITION ; ; CALLING SEQUENCE ; LDA 0,(BYTE POINT"ER TO NAME) ; C TDIR ; (YES RETURN) ; (NO RETURN) ; TDSTL= 1 ; AREA FOR FILE STATS STACK= TDSTL+UFDEL STACK TDIR: LDA 1,TDSTD ; FORM POINTER TO STATS AREA ADD 3,1 S STAT ; GET THE STATS JMP TDIRN ; NOT THERE CAN'T BE DIRECTORY MOV 1,3 ; MAKE STATS ACCESSABLE LDA 0,UFTAT,3 LDA 1,TDIAD AND# 0,1,SZR ; A DIRECTORY ?? RTRN ; YES JUST RETURN TDIRN: LDA 3,USP ; RESTORE USP LDA 2,SSOSP,3 ; GET OLD STACK POINTER ISZ SSRTN,2 ; NOT A DIRECTORY BUMP RETURN RTRN TDSTD: TDSTL TDIAD: ATDIR+ATPAR ;CARGS ; COPY ARGS FROM OLD STACK TO NEW STACK 0 CARGS: LDA 1,CARGL ; AC1 = -(NUMBER OF ARGS) TO MOVE MOV 2,3 ; AC3 = OLD STACK POINTER LDA 2,SSOSP,2 ; AC2 = OLD OLD STACK POINTER CARG1: LDA 0,0,2 ; MOVE A WROD STA 0,0,3 INC 2,2 INC 3,3 INC 1,1,SZRL! ; DONE ?? JMP CARG1 ; NO CONTINUE RTRN ; YES GO HOME CARGL: -(BP-ARGSW) ; ; INITIALIZATION FOR READING SYS.DR ; AC0 -> BUFFER (401 WORDS) ; AC1 = CHANNEL NUMBER ; CALL ; RDSIN ; -ERROR RETURN ; -NORMAL RETURN ; ; -2 CHANNEL# ; -1 CURRENT LOGICALxn BLOCK# ; 0 ENTRY PTR ; 1 (BEG OF BLK) ENTRY COUNT ; 2 FIRST ENTRY 0 RDSIN: ISZ SSRTN,2 MOVZR 0,2 SUB 0,0 STA 0,1,2 STA 0,-1,2 ; BEGIN WITH BLOCK 0 INCS 0,0 ; MAKE 400 ADD 1,0 ; CHANNEL+BLOCK INCREMENT STA 0,-2,2 MOV 1,2 LDA 0,DIRNP S ROPEN CPU JMP SERR RTRN DIRNP: .+1*2 DIRN: .TXT /SYS.DR/ SERR: LDA 3,SSOSP,3 DSZ SSRTN,3 STA 2,SSAC2,3 RTRN ; ; READ NEXT ENTRY FROM SYS.DR ; AC0 -> BUFFER ; AC2 = RETURNED ENTRY ADDRESS ; CALL ; RDSYS ; -ERROR OR EOF (CODE IN AC2) ; -NORMAL RETURN 0] RDSYS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN MOVZR 0,2 ; BUILD BUFFER ADDRESS .LOOP: LDA 0,1,2 MOV# 0,0,SZR JMP ENTF INC 2,0 LDA 1,-1,2 ISZ -1,2 LDA 2,-2,2 S RDB CPU JMP SERR NEG 0,2 COM 2,2 INC 0,0 STA 0,0,2 JMP .LOOP ENTF: LDA @0,0,2 ; NAME WORD MOVZ 0,0,SZR MOVO 0,0 ; SET CARRY IF NON VACENT LDA 0,ENTSZ LDA 1,0,2 ADD 1,0 STA 0,0,2 MOV# 0,0,SNC JMP .LOOP DSZ 1,2 JMP .+1 LDA 2,SSOSP,3 STA 1,SSAC2,2 RTRN ENTSZ: UFDEL ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2f$,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX C WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX: .+1*2 .TXT /^C.^W/ ; CMPNM ; ROUTINE TO COMPARE SYSTEM NAME WITH A USER NAME. ; AC1 POINTS TO THE SUYSTEM NAME ; AC0 POINTS TO THE USER NAME ; * WILL MATCH ANY SINGLE CHARACTER ; -(MINUS SIGN) WILL MATCH ANY NUMBER ; (INCLUDING 0) OF CHARACTERS ; CALL ; CMPNM ; - NO MATCH RETURN ; - MATCH RETURN SPNT =1 ; HOLDS POINTER TO SYSTEM NAME UPNT =SPNT+1 ; k3POINTER TO USER NAME SCNT =UPNT+1 ; # OF CHAR LEFT IN SYSTEM NAME UCNT =SCNT+1 ; # LEFT IN USER NAME TO PROCESS STXSX =UCNT ; STACK SIZE NEEDED FOR UNMSCN ROUTINE SEXT =UCNT+1 ; POINTS TO SYSTEM NAME EXTENSION STYSZ =SEXT ; STACK SIZE NEED FOR CMPNM R+!OUTINE STYSZ ; COMPARE SYSTEN NAME ROUTINE START ADDRESS ; ALL REGS ARE SAVED ON STACK ON ENTRY ; SAVE START ADDRESS OF NAMES FOR PROCESSING CMPNM: STA 0,UPNT,3 ; SAVE START OF USER NAME STA 1,SPNT,3 ; AND SYSTEM NAME TO MATCH LDA 0,C12 ; GET MAX SFKIZE OF NAME ADD 0,1 ; CALC ADDRESS OF SYSTEM NAME EXTENXION STA 1,SEXT,3 ; AND SAVE IT ; SET IN THE MAX # OF CHARS ALLOWED IN SYSTEM AND USER NAMES STA 0,UCNT,3 ; SET THAT 12 IS HIGHEST STA 0,SCNT,3 ; ALLOWED ; SEE IF THE NAME MATCHES C NMSCN ; GO SCAN THE NAME RTRN ; IF NO MATCH THEN TELL OUR CALLER ELSE ; HAD A MATCH, CHECK IF USER NAME IS ALL DONE(IE ENDED IN ZERO BYTE) L1: LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE MATCH ENDED C LDBT ; GET CHAR MOV# 1,1,SNR ; IF IS ZERO THEN USER NAME IS DONE JMP L2 ; GO MAKE SURE SYSTEM NAME DOES NOT ; HAVE EXTENSION ISZ UPNT,3 ; INC TO NEXT CHAR POSITION IN USER NAME LDA 0,PER ; CHECK FOR PERIOD IN USER NAME INDICATING SUB# 0,1,SZR ; AN EXTENSION IS PRESENT, IF NOT THEN JMP L1 ; LOOP TOPk LOOK MORE AT STRING ELSE ; SET UP TO MATCH THE NAME EXTENSIONS LDA 0,SEXT,3 ; GET ADDRESS OF SYSTEM NAME EXTENSION STA 0,SPNT,3 ; AND SET TO SCAN LDA 0,C2 ; SET MAX SIZE OF EXTENSION STA 0,SCNT,3 ; TO BE 2 FOR USER AND SYSTEN STA 0,UCNT,3 ; NAMES ; `SCAN THE EXTENSION FOR CORRECTNESS C NMSCN ; SCAN THE EXTENSION RTRN ; GIVE UP ON NO MATCH ELSE JMP L3 ; WE HAVE NAMES THAT MATCH ; USER NAME HAS NO EXTENSION, CHECK IF SYSTEN NAME HAS EXTENSION L2: LDA 0,SEXT,3 ; GET ADDR OF EXTENSION C LDBT  ; GET 1ST CHAR OF IT MOV# 1,1,SZR ; IF HAS EXTENSION THEN RTRN ; NO MATCH ELSE ; WE HAVE A NAME MATCH, RETURN TO CALLER AT MATCH ADDRESS L3: LDA 2,SSOSP,3 ; GET CALLER STACK POINTER ISZ SSRTN,2 ; INC RETURN POINTER TO MATCH ADDR RTRN ; RETURN TO CALLER PER: ". ; PERIOD SEPARATING FILE NAME FROM EXTENASION DASH: "- ; ANY LENGTH MATCH CHAR STAR: "* ; ANY CHAR MATCH C12: 12 ; # OF CHARS IN FILE NAMES C2: 2 ; # OF CHARS IN FILE NAME EXTENSIONS ; INTERNAME ROUTINE FOR "CMPNM" TO TRY FOR MATCH OF WHh5AT IS LEFT ; OF STRING. ON ENTRY AC2 POINTS TO THE STACK OF THE CALLER ; WHICH CONTAINS WHERE THE CALLER WAS IN COMPARING THE 2 STRINGS. ; THIS ROUTINE STARTS AT WHERE THE CALLER LEFT OFF AND SCANS THE LINE ; IF NO MATCH THEN RETURNS TO CALLER AT CALL+1 WITH NOTHING CHANGED. ; IF MATCH THEN UPDATES THE USER POINTER IN THE CALLERS STACK TO ; POINT TO THE CHAR THAT ENDED THE COMPARE AND RETURNS AT CALL+2. ; IF ROUTINE ENCOUNTERS DASH THEN IT CALLS ITSELF WITH THE USER NAME ; POINTER POINTING TO THE CHAR AFTE~R THE DASH. IF ON RETURN IT HAS A ; MATCH THEN IT RETURNS TO ITS CALLER WITH A MATCH. IF NO MATCH THEN ; INCREMENTS THE SYSTEM NAME POINTER BY ONE AND CALLS ITSELF AGAIN. ; PROCESS CONTINUES TILL EITHER MATCH OR SYSTEM FILE NAME ; EXHAUSTED. STXSX ; ROUTINE STACK SIZE NMSCN: ; ROUTINE START ADDRESS ; COPY WHERE CALLER WAS AT IN SCAN TO OWN STACK LDA 0,SPNT,2 ; GET WHERE WAS AT IN SYSTEM NAME STA 0,SPNT,3 ; SAVE IN OWN STACK LDA 0,UPNT,2 ; GET WHERE AT IN USER NAME STA 0,UPNT,3 ; AND STORE LDA 0,-BSCNT,2 ; GET # CHARS MAX LEFT IN SYSTEM NAME STA 0,SCNT,3 ; AND STORE IT LDA 0,UCNT,2 ; SAME WITH USER NAME STA 0,UCNT,3 ; GET CHAR FROM EACH STRING TO MATCH NM1: LDA 0,UPNT,3 ; PICK UP CHAR FROM C LDBT ; USER STRING MOV 1,2 ; AND SAVE IN AC2 SUB / 1,1 ; SET SYSTEM CHAR TO NULL AND LDA 0,SCNT,3 ; IF END OF SYSTEM STRING MOV# 0,0,SNR ; REACHED CHECK TO SEE JMP NM15 ; IF USER CHAR WAS NULL LDA 0,SPNT,3 ; ELSE PICK UP CHAR C LDBT ; FROM SYSTEM STRING ; CHECK TO SEE IF THEY ARE EQUAL NM15: SSUB# 1,2,SZR ; IF NOT EQUAL THEN JMP NM3 ; BRANCH ELSE ; WE HAVE MATCH, SEE IF MATCH IS THAT OF END OF STRINGS MOV# 2,2,SNR ; IF WE ARE AT END OF STRINGS THEN JMP NM5 ; NAMES MATCH ELSE ; NAMES NOT ALL MATCHED YET, CHECK TO SEE IF HAVE REACHED END OEqF ; WHAT SHOULD BE PROCESSED IN NAMES NM2: ISZ UPNT,3 ; UPDATE NAME POINTERS TO ISZ SPNT,3 ; NEXT CHAR DSZ SCNT,3 ; COUNT SYSTEM NAME CHAR NOP DSZ UCNT,3 ; IF HAVE NOT MATCHED MAX # USER JMP NM1 ; CHARS THAN GET NEXT CHAR ELSE JMP NM5 ; WE HAVE% COMPLETE MATCH ; CHARS DID NOT MATCH, CHECK FOR SPECIAL CHARS NM3: LDA 0,PER ; IF USER NAME CHAR IS A SUB# 0,2,SNR ; PERIOD THEN IS END OF USER JMP NM4 ; USER NAME SO BRANCH ELSE LDA 0,DASH ; IF IS DASH THEN GO SUB# 0,2,SNR ; WHAT PART OF REST O FF SYSTEM NAME JMP NM9 ; MATCH USER NAME ELSE LDA 0,STAR ; IF IS STAR AND THE SYSTEM SUB# 0,2,SNR ; NAME CHAR IS NOT A ZERO THEN MOV# 1,1,SNR ; SAY THE CHARS MATCH ELSE RTRN ; RETURN WITH NO MATCH JMP NM2 ; FOUND PERIOD IN USER NAME, CHECK THAT SYSTEM NAME IS ENDED NM4: MOV# 1,1,SZR ; IF SYSTEM NAME DID NOT END AT RTRN ; SAME POINT AS USER THEN NO MATCH ELSE ; NAMES DO MATCH, RETURN ADDRESS OF WHERE MATCH ENDED IN USER NAME ; TO CALLER. NM5: LDA 2,SSOSP,3 ; GET ADDRESS OF CALLER STACK LDA O0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE ENDED STA 0,UPNT,2 ; RETURN TO CALLER ; INC RETURN ADDR TO SUCCESSFUL RETURN ADRESS AND DONE ISZ SSRTN,2 RTRN ; FOUND DASH IN USER NAME, INC PAST THE DASH NM9: ISZ UPNT,3 ; CHECK, IF DASH WAS LAST CHAR OF NAME THEN WE HAVE A MATCH LDA 0,UPNT,3 ; GET POINTER TO USER NAME C LDBT ; GET NEXT CHAR OF NAME LDA 0,PER ; IF IT IS ENDED THEN SUB# 0,1,SZR ; WE HAVE A MATCH ELSE MOV# 1,1,SNR ; WE HAVE NO MATCH JMP NM5 ; MATCH ; SEE IF WHAT IS LEFT OF USER NAME MATCHES WHATS LEFT OF SYSTEM NAME NM10: C NMSCN ; SCAN NAMES FOR MATCH MOV# 1,1,SKP ; IF NO MATCH THEN SKIP ELSE JMP NM5 ; IF MATCH THEN WOOPY, GO RETURN SUCCESS ; DOES NOT MATCH, SEE IF ANYTHING LEFT OF SYSTEM NAME TO TRY MATCH ISZ SPNT,3 ; INC SYSATEM NAME POINTER TO NEXT CHAR DSZ SCNT,3 ; IF STILL SOMETING LEFT OF NAME THEN MOV# 0,0,SKP ; SKIP ELSE RTRN ; RETURN WITH NO MATCH ; NOT PAST MAX # OF CHARS IN SYSTEM NAME, STILL CHECK FOR NAME END LDA 0,SPNT,3 ; GET POINTER TO SYSTEM NAME C LDBT ; GET CHAR FROM IT MOV# 1,1,SNR ; IF IS END OF SYSTEM NAME THEN RTRN ; NO MATCH POSSIBLE ELSE JMP NM10 ; GO SEE IF MATCH TMP= 1 ; TEMP MONTH= TMP+1 ; MONTH/DAY/YEAR DAY= MONTH+1 YEAR= DAY+1 FEB= YEAR+1 ; FEBUARY DATE= FEB+1 ; ACCUMULATED DATE STACK= DATE ; STACK LENGTH STACK CNVRT: ISZ SSRTN,2 ; ASSUME GOOD RETURN LDA 2,CM3 ; THREE ARGS STA 2,TMP,3 ; SET COUNTER LDA 2,MONTD ; POINT TO MONTH ADD 3,2 CNVR0: C .ASCD ; CONVERT TO BINARY JMP NUMER ; SOME TYPE OF ERROR STA 1,0,2 ; SARVE VALUE INC 2,2 ; POINT TO NEXT ISZ TMP,3 ; DONE WITH THREE ? JMP CNVR1 ; NO CONTINUE JMP CNVR2 ; YES GO PROCESS CNVR1: LDA 1,DASH ; POINT TO NEXT ARGUMENT C INDEX JMP NUMER ; TRY AGAIN INC 0,0 JMP CNVR0 ; NO CONVERT NEXT CNVR2: LDA 1,YEAR,3 ; < YES GET YEAR LDA 0,K1968D ; TRY TO TAKE OUT 1968 SUBZ# 0,1,SNC ; COME OUT ?? LDA 0,K68D ; NO TRY 68 SUBZ 1,0,SEZ JMP NUMER ; BAD YEAR STA 0,YEAR,3 ; SAVE YEAR MOVZR 0,1,SNC ; A LEAP YEAR PERHAPS ? MOVR 1,1 LDA 2,K14 ; IF SO ADD DAY TO FEB MOVCL 2,2 STA 2,FEB,3 LDA 2,K12 LDA 1,MONTH,3 MOV 1,1,SZR SUBZ# 1,2,SNC ; LEGAL MONTH ?? JMP NUMER ; NO PUNISH LDA 2,MTBL SUB 0,0 ; CLEAR RESULT WORD CNVR3: LDA 1,0,2 ; AC1= DAYS TO THIS MONTH COM# 1,1,SNR ; FEB PERHAPS ?? LDA 1,FEB,3 ; YES GET ITr DSZ MONTH,3 ; DONE ? JMP CNVR4 ; NO ADD THIS MONTH JMP DAYS ; YES GO TO DAYS CNVR4: ADD 1,0 INC 2,2 ; BUMP POINTER JMP CNVR3 ; CONTINUE DAYS: LDA 2,DAY,3 ; GET DAYS SUBZ# 2,1,SNC ; DAYS LEGAL ? JMP NUMER ; SHAME ON YOU ADD 2,0 ; YES ADD THEM IN STA 0,DATE,3 ; SAVE DATE YEARS: LDA 0,YEAR,3 ; GET YEAR YEAR1: MOVZ 0,0,SNR ; ZER0 ? JMP FINI ; YES ALL DONE INC 0,0 ; NO BUMP YEAR LDA 2,CM366 ; 365 DAYS PER LEAP YEAR MOVZR 0,1,SNC ; IS IT LEAP YEAR MOVR 1,1,SZC INC 2,2 ; NO MAKE IT 365 DAYS N NEG 2,2 LDA 1,DATE,3 ADD 1,2 STA 2,DATE,3 JMP YEAR1 ; CONTIUE FINI: LDA 2,SSOSP,3 ; RETURN DATE TO CALLER LDA 1,DATE,3 STA 1,SSAC1,2 RTRN NUMER: LDA 3,SSOSP,3 DSZ SSRTN,3 LDA 0,SSAC0,3 ; AC0 => ARGUMENT LDA 2,.ERTIM ; TIME ERROR MESAGE ER1 ݪ3 ; GIVE ERROR MESSAGE RTRN ; ALL ERRORS ARE FATAL RTRN MTBL: .+1 31. -1 31. 30. 31. 30. 31. 31. 30. 31. 30. 31. CM3: -3 MONTD: MONTH K1968D: 1968. K68D: 68. K14: 14. K12: 12. CM366: -366. .ERTIM: ERTIM CLI.SRoo0<.LCNS ;COPYRIGHT (C) DATA GENERAL CORPORATION,1972,1973,1974,1975,1976,1977 ;ALL RIGHTS RESERVED ;LICENSED MATERIAL-PROPERTY OF DATA GENERAL CORPORATION ; ; CLI MAIN PROGRAM ; .TITL CLI ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS .COMM TASK, 1*400+16 .REV 6,30. ; REV NUMBER .RB CLI.RB .ENT CLI .ENT STOVE ; STACK OVERFLOW LOCATION .ENT INAME ; INPUT DEVICE NAME TEXT ADDRESS .ENT TTOUT ; OUTPUT DEVICE NAME TEXT ADDRESS .ENT SPYF ; SPY FILE F6LAG .ENT ERFLG ; ERROR FILE FLAG .ENT LOGER ; LOG FILE ERROR ROUTINE .ENT CLIRS ; RESTART ENTRY POINT FOR FATAL ERRORS .ENT CLIDR ; BYTE POINTER TO CLI DIRECTORY .ENT CURDR ; BYTE POINTER TO CURRENT DIRECTORY .ENT LSTDR ; BYTE POINTER TO PREVIOUS DIRoECTORY .ENT SPARG ; SPY CHANNEL ARGUMENT .ENT DOT ; TIME STAMP ROUTINE .ENT CMDER ; COMMAND ERROR ROUTINE .ENT TBUFR ; ADDRESS OF TEMP BUFFER HEADER .ENT CBUFR ; ADDRESS OF COMMAND BUFFER HEADER .ENT SBUFR ; ADDRESS OF SCRATCH BUFFER HEADER ; ; GENv%ERAL SUBROUTINES ; .EXTN STBT ; STORE BYTE ROUTINE .EXTN COMP ; STRING COMPARE .EXTN WRLIN ; LINE OUTPUT .EXTN GETARG ; NEXT ARG .EXTN GETSW ; GET SWITCHES .EXTN MOVE ; CHAR MOVER .EXTN ERR1,ERR2 ; ERROR HANDLERS ; ; MISC ;  .EXTN REVV ; OVERLAY+ REV LOCATION .EXTN CALL,RTRN .EXTN USE ; END OF STACK POINTER .EXTN RDLIN GETLI CLBUF PCBUF GCBUF .TXTM 1 .NREL ; STACK VARIABLES NAMP= 1 ; POINTER TO NAME NAME= NAMP+1 ; STORAGE FOR NAMES TMP= NAME+50 ; TEMP FOR ALL KINDS OF THINGS CBNA= TMPP+1 ; COMMAND FILE NAME TBNA= CBNA+14 ; TEMP FILE NAME SBNA= TBNA+14 ; SCRATCH FILE NAME TBUF= SBNA+14 ; TBUFF CBUF= TBUF+SCDBS ; CBUFF SBUF= CBUF+SCDBS ; SBUFF STACK= SBUF+SCDBS ; STACK SIZE CLI: SEQZ 2 ; REQUEST FOR CLI PUSH ? SUBZL 2,2 ; YES- &SET PUSH PENDING FLAG =1 STA 2,PFLAG ; SAVE PUSH FLAG LDA 0,INAD S GCIN ; GET CONSOLE IN NAME NOP LDA 0,OAD S GCOUT ; GET CONSOLE OUT NAME NOP LDA 0,CLIDP ; GET CLI DIRECTORY FOR LATER S GDIR NOP LDA 0,CURDP ; PICK UP POINTER TO CURRENT DIRECT:ORY S GDIR ; INITIALIZE CURRENT=CLI DIRECTORY NOP LDA 0,LSTDP ; PICK UP POINTER TO LAST DIRECTORY S GDIR ; INITIALIZE LAST=CLI DIRECTORY NOP SUB 0,0 STA 0,TIMS ; SET TIME STAMP OFF STA 0,@.SPYF ; ZIP SPY FLAG STA 0,@.SPARG ; CLEAR FIRST ARGUMENT4 WORD LDA 3,USTP LDA 0,BKADR ; BREAK ADDR STA 0,USTBR,3 LDA 0,ITADR STA 0,USTIT,3 ; INT ADDR LDA 2,NULPP ; SET ERROR MESSAGE TO NULL ; CLI FATAL ERROR RESTART ENTRY CLIRS: LDA 3,USTP LDA 3,USTHU,3 LDA 1,SLOF ; STACK LENGTH ADD 1,3 STA 3,USP ; SET/RESET STACK PTR LDA 0,STAKL STA 0,SSLGT,3 ; SET INITIAL STACK LENGTH ADD 0,3 ; FORM INITIAL FRAME SIZE STA 3,@.USE ; STORE AS TOP OF STACK S MEM ; GET CURRENT MNAX LDA 2,STOAD LDA 0,@.USE ; DESIRED NMAX SUB 1,0 ; INCREMENT(DECREMENT)=DESIRED-;CURRENT S MEMI ; ADJUST FOR STACK LDA 2,STOAD ; STACK OVERFLOW MESSAGE STA 2,@USP ; SAVE ERROR POINTER SUB 1,1 LDA 0,INAD ; OPEN INPUT CHANNEL S OPEN CIN NOP LDA 0,OAD ; OPEN OUTPUT CHANNEL S OPEN COUT NOP LDA 1,@USP ; HOLD ERROR MESSAGE POINTER IN AC1 LDA 0,CRMSP ; PUMP CARRIAGE RETURN C WRLIN ; TO INSURE WE CAN BE SEEN MOV 1,0 ; RESTORE ERROR MESSAGE POINTER C WRLIN ; SEND ERROR IF ANY JMP CLIR1 ; CONTINUE ITADR: ITAD BKADR: BRAD SLOF: -SSLGT STAKL: STACK OVLD: OLNAM*2 STOAD: SOMES*W2 OAD: TTOUT*2 INAD: INAME*2 C1012: 405*2 .ERFLG: ERFLG*2 CLIDP: CLIDR CURDP: CURDR LSTDP: LSTDR ERAD: EMES*2 .USE: USE ERFLG: 0 .SPARG: SPARG .SPYF: SPYF CRMSP: CRMES*2 NULPP: NULP*2 TIMS: 0 ; TIME STAMP .REVV: REVV ; OVERLAY REV LOCATION .ERUFT: ERUFT !.EROVN: EROVN .OVFER: OVFER PFLAG: 0 ; PUSH FLAG CHTAB: .+1 ; CHANNEL TABLE COMCH .PUSCH: PUSCH INSCH CH1 CH2 CH3 -1 CLIR1: BPT NAME NAMP ; SOMEWHERE TO BUILD NAMES LDA 1,NAMP,3 ; PLACE TO BUILD OVERLAY FILE NAME LDA 0,CLIDP ; DIRECTORY NAME  C MOVE ; MOVE IN DIRECTORY NAME STA 1,TMP,3 ; SAVE POINTER IN A SAFE PLACE LDA 0,ERAD C MOVE ; FORM ERROR FILE NAME LDA 0,NAMP,3 ; AC0 => COMBIMED NAME S ROPEN ERCH ; OPEN ERROR CHANNEL NOP ADC 2,2 ; SET ERROR FLAG TO NOT THERE STA 2,ERFLG SUB 0,0 ; POSITION TO HIGH ERROR COE NUMBER LDA 1,C1012 S SPOS ERCH NOP INCZL 0,1 ; TWO BYTES LDA 0,.ERFLG ; READ HIGH ERROR NUMBER S RDS ERCH NOP LDA 0,OVLD ; FILE NAME LDA 1,TMP,3 ; PLACE TO MOVE NAME C MOVE ; COMBINE THE TWO LDA 0,NAMP,3 ; AC08 => COMBINED NAME S OVOPN OVCH ; OPEN OVERLAY CAHNNEL JMP CLIR2 ; AN ERROR FIND OUT WHAT TYPE LDA 0,.REVV ; SEE IF PROPER REV SUB 1,1 INCS 1,2 ; BY READING FIRST BLOCK S RDB OVCH ; INTO OVERLAY AREA JMP @.OVFER ; VERY BAD NEWS MOV 0,2 ; MAKE WORD dPACCESSABLE LDA 1,0,2 ; GET REV WORD LDA 2,.EROVN ; ERROR CODE SUB# 1,0,SNR ; CORRECT REV ?? JMP CLIR3 ; YES CONTINUE CLIR2: LDA 1,.ERUFT SUB# 1,2,SZR ; CHANNEL ALREADY OPEN ?? JMP @.OVFER ; NO GIVE ERROR CLIR3: LDA 1,.TBUFR ; SET UP TBUFF JSR @.!SETUP LDA 1,.CBUFR ; SET UP CBUFF JSR @.SETUP LDA 1,.SBUFR ; AND SBUFF JSR @.SETUP ; ; COMMAND ERRORS ENTER HERE ; ; CLOSE ALL RELEVANT CHANNELS CMDER: LDA 1,CHTAB ; PICK UP CHANNEL TABLE CMDE1: MOV 1,2 ; MAKE CHANNEL TABLE ACCESSIBLE INC 1,1 ; {kBUMP TO NEXT ENTRY LDA 2,0,2 ; GET ENTRY SNEM1 2 ; END OF TABLE ?? JMP CMDE2 ; YES GET OUT S CLOS CPU ; NO CLOSE THE CHANNEL NOP  ; MAY NOT BE OPEN JMP CMDE1 ; AND TRY NEXT ; SET/RESET THE STACK CMDE2: LDA 3,USTP ; RESET THE STACK POINTERS LD[A 3,USTHU,3 LDA 1,SLOF ; STACK LENGTH ADD 1,3 STA 3,USP ; SET/RESET STACK PTR LDA 2,STAKL STA 2,SSLGT,3 ; SET INITIAL STACK LENGTH ADD 3,2 ; FORM INITIAL FRAME SIZE STA 2,@.USE ; STORE AS TOP OF STACK S MEM ; GET CURRENT MNAX JMP @LOGEP ; AN ERR}OR RESTART THE WHOLE THING MOV 2,0 SUB 1,0 ; INCREMENT(DECREMENT)=DESIRED-CURRENT S MEMI ; ADJUST FOR STACK JMP @LOGEP ; OPEN/RE-OPEN THE CONSOLE SUB 1,1 ; NORMAL OPENS LDA 0,OAD ; OPEN OUTPUT FILE S OPEN COUT NOP LDA 0,INAD ; OPEN INPUT FILEY S OPEN CIN NOP ; ; PROCESS PUSH (CLI.CM) IF REQUESTED- ; PUSH FLAG CODES ARE: ; 0 => NO PUSH REQUESTED ; 1 => PUSH PROCESS PENDING ; -1 => PUSH PROCESSING IN PROGRESS ; PSERP: LDA 3,USTP ; POINT TO OUR UST LDA 3,USTPC,3 ; GET FG/BG FLAG LDA 0,PFLAG ; GET PUSH FLAG SNEZ 0 ; IF NO PUSH PROCESSING JMP NLIN ; THEN GET NEXT LINE FROM CONSOLE SNEM1 0 ; ELSE IF PUSH IN PROGRESS JMP PSHER ; THEN TREAT AS FATAL ERROR ON PUSH. ADC 0,0 ; CODE = -1 TO FLAG STA 0,PFLAG ; PUSH PROCESSING IN PROGRESS. LDA 0,CLICM ; AC0 => FCLI.CM SNEZ 3 ; FOREGROUND ?? INC 0,0 ; NO AC0 => CLI.CM S OPEN PUSCH ; OPEN THE FILE JMP OPENR ; BAD NEWS LDA 2,.TBUFR C CLBUF ; CLEAR TBUFF LDA 1,.PUSCH ; AC1 = CHANNEL NUMBER INSE1: C RDLIN ; READ A LINE INTO TBUF 9 JMP INSE2 ; END OF FILE CLOSE UP JMP INSE1 ; CONTINUE READING UNTIL END OF FILE INSE2: S CLOS PUSCH ; CLOSE THE FILE NOP LDA 2,.TBUFR ; RESET AC2 IN CASE OF ERROR JMP DOIT ; EXECUTE IT OPENR: ER1 ; REPORT ERROR JMP PSERP ; TAKE FATAL PUSH ERROR PATcH. ; FATAL ERROR DURING PUSH PROCESSING PSHER: SEQZ 3 ; IF WE ARE IN FOREGROUND THEN JMP PSHRT ; JUST TAKE ERROR RETURN S FGND ; ELSE DETERMINE BG PROGRAM LEVEL. NOP MOVZR 1,1,SNR ; IF AT BG LEVEL 0 THEN JMP NLIN ; GO TO CONSOLE FOR NEXT LINE PSHRT: LDA 2,.ERFUE ; ELSE RETURN FATAL UTILITY ERROR CODE S ERTN ; TO CALLER. JMP PSHRT TIMLN: TLIN*2 CLICM: CLIC*2 .CBUFR: CBUFR .TBUFR: TBUFR .SBUFR: SBUFR .SETUP: SETUP EOFCH: EOT EOLCH: EOL .ERFUE: ERFUE ; ; PROCESS NEXT LINE ; NLIN: SUB 0,0 ; RESAET PUSH FLAG = STA 0,@.PFLAG ; NO PUSH REQUESTED. LDA 0,@.TIMS ; DATE ?? MOVR# 0,0,SNC ; WELL ?? JMP PRMPT ; NO SKIP IT S GTOD ; YES GET TIME JMP PRMPT ; WHAT CAN I DO STA 0,NAME,3 ; ANY OLD PLACE WILL DO LDA 0,TIMLN ; AC0 => FORMAT MESSAGE C: WRLIN ; WRITE IT OUT SSAC2 SSAC1 NAME PRMPT: LDA 0,STAD ; PUMP OUR PROMPT  C WRLIN ; READ LINE INTO TBUFF LDA 2,.TBUFR ; AC2 => TBUFF HEADER C CLBUF ; CLEAR TBUFR LDA 1,.CIN ; AC1= CHANNEL NUMBER C RDLIN ; READ A LINE FROM INPUT CHANNEL NOP  ; END OF FILE RETURN DOIT: DSZ BFFFB,2 ; IF SOMETHING TO PROCESS THEN JMP CHKCR ; SEE IF THERE IS AN EOL JMP NLIN ; ELSE JUST GET NEXT LINE. CHKCR: LDA 0,BFFFB,2 ; PICK UP FREE BYTE POINTER NEG 0,0 ; AND BACK IT UP ONE CHAR COM 0,0 ; BEFORE EOT. C G\KCBUF ; GET CHARACTER- LDA 0,EOLCH ; IF IT IS SUB# 0,1,SNR ; AN EOL THEN JMP PUTBK ; JUST RESTORE EOT ELSE MOV 0,1 ; STORE A C/R TO INSURE C PCBUF ; PROPER PROCESSING. PUTBK: LDA 1,EOFCH ; RESTORE EOT C PCBUF ; IN TBUFF. ; NOW PROCESS LINE LDA+- 2,.CBUFR ; AC2 => CBUFF HEADER C CLBUF ; CLEAR COMMAND BUFFER LDA 2,SPYF ; AC2 <= LOG FILE FLAG SNEZ 2 ; IF NO LOG FILE JMP NOLOG ; THEN NOTHING TO DO S UPDAT KCH ; ELSE INSURE LOG FILE INTEGRITY. JMP LOGER ; FATAL ERROR NOLOG: C GETLI ; EXPAND A*ND EXECUTE THE LINE. JMP NLIN ; GET NEXT LINE .CIN: CIN STAD: PRMES*2 LOGEP: CLIRS ; ; SET/RESET TIME STAMP ROUTINE ; 0 DOT: ISZ @.TIMS ; DOT COMMAND NOP RTRN ; ; LOG FILE ERROR ROUTINE ; LOGER: S CLOS KCH ; CLOSE LOG FILE NOP SUB 2,2 ; CLEAR cAC2 AND STA 2,SPYF ; MARK FILE CLOSED LDA 2,LOGEM ; AC2 = LOG ERROR MESSAGE JMP @LOGEP ; RESET THE WORLD LOGEM: LOGMS*2 SPYF: 0 .PFLAG: PFLAG ; ; ERROR ON CLI.OL OPEN ; OVFER: LDA 0,..OLN ; AC0 => :CLI.OL INC 0,0 ; AC0 => CLI.OL ER1 ; GIVE ERRORn S FGND JMP OVFE1 MOVZR 1,1 ADD 1,0 LDA 2,USTP LDA 1,USTPC,2 ADD 1,0 MOV 0,0,SNR ; IN BG AT LEVEL 0 WITH NO FG ? JMP OVFE1 ; YES RELEASE MASTER DIRECTORY S RTN ; NO RETURN OVFE1: LDA 3,USP LDA 0,NAMPT ; FORM BYTE POINTER TO NAME SPACE ADDZWL 3,0 S MDIR NOP S RLSE NOP JMP OVFE1 ; TRY TRY TRY AGAIN ; ; MISCELLANEOUS HANDLING ; STOVE: LDA 2,STMOD ; STACK OVERFLOW JMP @LOGEP JMP BKER ; BREAK ERROR RETURN BRAD: LDA 2,BKMAD ; BREAK RETURN JMP @LOGEP ITAD: LDA 2,INMAD ; INTERUPT RETURN  JMP @LOGEP BKER: ER2 1 ; REPORT ERROR JMP BRAD NAMPT: NAME .TIMS: TIMS BKMAD: BKMES*2 INMAD: INMES*2 STMOD: SOMES*2 ..OLN: OLNAM*2 ; CLI VIRTUAL BUFFER HEADERS TBUFR: 0 ; FIRST BYTE ADDRESS OF BUFFER 0 ; RUNNING LOGICAL BYTE POINTER 0 ; LOGIHCAL FIRST BYTE OF CURRENT PAGE 0 ; BLOCK MODIFIED FLAG <>0 MODIFIED 0 ; LOGICAL FIRST FREE BYTE ADDRESS 0 ; FILE NAME FOR THIS BUFFER 1B7+TCHAN ; CHANNEL NUMBER 1B0 IF NOT OPEN TBUF ; STACK DISPLACEMENT TO BUFFER TBNAM*2 ; NAME FOR THIS BUFFER 3TBNA ; STACK DISPLACEMENT TO NAME POINTER CBUFR: 0 ; FIRST BYTE ADDRESS OF BUFFER 0 ; RUNNING LOGICAL BYTE POINTER 0 ; LOGICAL FIRST BYTE OF CURRENT PAGE 0 ; BLOCK MODIFIED FLAG <>0 MODIFIED 0 ; LOGICAL FIRST FREE BYTE ADDRESS 0 ; FILE NAME FOR THIS BUFFER 1B7+CCHAN ; CHANNEL NUMBER 1B0 IF NOT OPEN CBUF ; STACK DISPLACEMENT TO BUFFER CBNAM*2 ; NAME FOR THIS BUFFER CBNA ; STACK DISPLACEMENT TO NAME POINTER SBUFR: 0 ; FIRST BYTE ADDRESS OF BUFFER 0 ; RUNNING LOGICAL BYTE POINTER 0 ~; LOGICAL FIRST BYTE OF CURRENT PAGE 0 ; BLOCK MODIFIED FLAG <>0 MODIFIED 0 ; LOGICAL FIRST FREE BYTE ADDRESS 0 ; FILE NAME FOR THIS BUFFER 1B7+SCHAN ; CHANNEL NUMBER 1B0 IF NOT OPEN SBUF ; STACK DISPLACEMENT TO BUFFER SBNAM*2 ; NAME FOR THIS BUFFER SBNA ; STACK DISPLACEMENT TO NAME POINTER ; SET UP BUFFER SETUP: MOV 3,2 LDA 3,USP STA 2,TMP,3 ; SAVE RETURN MOV 1,2 ; MAKE HEADER ACCESSABLE LDA 0,CLIDI ; ADD DIRECTORY TO FILENAME LDA 1,BFNDP,2 ; WHERE TO PUT NAME ADDZL 3,1 ; MAKE IT B7cYTE POINTER STA 1,BFFIL,2 ; SAVE POINTER C MOVE ; MOVE IN DIRECTORY NAME MOV 1,0 ; PUT IN COLN LDA 1,CCOL C STBT INC 0,1 LDA 0,BFNAM,2 ; MOVE IN NAME LDA 3,USTP LDA 3,USTPC,3 MOV 3,3,SNR ; FORGROUND ?? INC 0,0 ; NO GET RID OF F STA 3,BFFFB,2 ; SAVE FOR LATER C MOVE STA 1,BFRPT,2 ; SAVE POINTER TEMPORARILY S FGND ; GET LEVEL NOP LDA 0,BFFFB,2 ; GET FORGROUND FLAG ADDOL 0,0 SUB 0,1 ; TAKE OUT FORGROUND LEVELS LDA 0,K60 ; MAKE IT ASCII ADD 0,1 LDA 0,BFRPT,2 C STBT ; STORE IT INC 0,0 ; BUMP POINTER SUB 1,1 C STBT ; STORE NULL LDA 1,BFBDP,2 ; FORM BUFFER ADDRESS ADDZL 3,1 STA 1,BFADR,2 LDA 1,BFCHN,2 ; MARK CHANNEL CLOSED MOVZL 1,1 MOVOR 1,0 STA 0,BFCHN,2 LDA 0,BFFIL,2 ; GET FILE NAME MOVZR 1,2 ; AND CHANNEL # S CLOS CNPU ; CLOSE CHANNEL NOP ; SO . . S ECLR ; CLEAR USE COUNT JUST IN CASE NOP ; WHO CARES S DELE ; DELETE FILE NOP JMP @TMP,3 ; RETURN CCOL: ": K60: '60' CLIDI: CLIDR ; MESSAGES AND OTHER BULKY STUFF ** .NOLOC 1 TBNAM: .TXT *FCLI.T* CBNAM: .TXT *FCLI.C* SBNAM: .TXT *FCLI.S* EMES: .TXT *:CLI.ER* OLNAM: .TXT *:CLI.OL* CLIC: .TXT *FCLI.CM* PRMES: .TXT *R<15>* TLIN: .TXT "^D^Z<2>:^D^Z<2>:^D^Z<2><15>" BKMES: .TXT *BREAK<15>* INMES: .TXT *<177>INT<15>* SOMES: .TXT *STACK OVERFLOW.<15>* LOGMS: .TXT *LOG UFILE ERROR. <15>* CRMES: .TXT *<15>* NULP: 0 ; NULL ERROR MESSAGE INAME: .BLK 6 ; STORAGE FOR CONSOLE IN NAME TTOUT: .BLK 6 ; STORAGE FOR CONSOLE OUT NAME CLIDN: .BLK 6 ; STORAGE FOR CLI DIRECTORY CURDN: .BLK 6 ; STORAGE FOR CURRENT DIRECTORY LSTDN: .lBLK 6 ; STORAGE FOR PREVIOUS DIRECTORY SPARG: .BLK 6 ; STORAGE FOR LOG FILE PASSWORD CLIDR= CLIDN*2 ; POINTER TO CLI DIRECTORY CURDR= CURDN*2 ; POINTER TO CURRENT DIRECTORY LSTDR= LSTDN*2 ; POINTER TO PREVIOUS DIRECTORY .TXT /COPYRIGHT(C)DGC,1972,73,:kZ74,75,76,77, ALL RIGHTS RESERVED/ ** .NOLOC 0 .END CLI BDPAS.SR5 P 9 ; ; PROGRAMS TO CONVERT UNSIGNED DOUBLE ; PRECISION BINARY TO ASCII CHARACTER ; STRINGS ENDING WITH A NULL. ; LEADING ZEROES ARE SUPPRESSED. ; AC0 IS OUTPUT STRING POINTER ; AC1 IS HIGH ORDER WORD ; AC2 IS LOW ORDER WORD ; ON RETURN, AC0 IS UPDATED TO POIsNT TO NULL. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CBDPAS .RB CBDPAS.RB ** .ENDC J .TITL BBDPAS .RB BBDPAS.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT BDP6~AD BDPAO BDPAH ; DP CONVERT ROUTINES .ENT DSUB ; DOUBLE PRECISION SUBTRACT .EXTN CALL STBT LDBT RTRN OP=1  ; OUTPUT POINTER HW=OP+1 ; HIGH ORDER WORD LW=HW+1 ; LOW ORDER WROD DPAD=LW+1 ; ADDRESS OF NUMBER CAD=DPAD+1 ; TABLE ADDRESS PEND=CAD+1 ;nC STACK SIZE ; DOUBLE PRECISION BINARY TO ASCII DECIMAL PEND BDPAD: STA 1,HW,3 ; SAVE HIGH ORDER WROD LDA 1,DTABL ; TABLE ADDRESS JMP CNVRT ; JOIN COMMON CODE ; DOUBLE PRECISION BINARY TO ASCII OCTAL PEND BDPAO: STA 1,HW,3 ; SAVE HIGH ORDER WORD I2 LDA 1,OTABL ; PICK UP OTABL ADDRESS JMP CNVRT ; JOIN COMMON CODE ; DOUBLE PRECISION BINARY TO ASCII HEX PEND BDPAH: STA 1,HW,3 ; SAVE HIGH ORDER WORD LDA 1,HTABL ; POINT TO HEX TABLE CNVRT: STA 0,OP,3 ; SAVE OUTPUT POINTER STA 1,CAD,3 ; SAVE TABL*E ADDRESS IN STACK LDA 0,HWAD ; STACK OFFSET OF PAIR ADDZ 3,0 ; MAKE ABS. ADDRESS STA 0,DPAD,3 LDA 1,SSAC2,2 ; SAVE LOW ORDER WORD STA 1,LW,3 LOOP1: SUBC 2,2 ; CLEAR AC2 LOOP: LDA 0,CAD,3 ; TABLE ADDRESS LDA 1,DPAD,3 ; NUMBER ADDRESS C DSUB ; C(1)-C(0) MOVL# 0,0,SZC ; NEGATIVE RESULT ? JMP NEWD ; YES OUTPUT DIGIT STA 0,HW,3 ; NEW HIGH STA 1,LW,3 ; NEW LOW INC 2,2 ; INC. DIGIT JMP LOOP NEWD: MOVL# 2,2,SNR ; A ZERO RESULT AND NO DIGITS SEEN ?? JMP NEWD1 ; YES DON'T OUTPUT LDA 0,OUTBL ;L NO OUTPUT THIS DIGIT ADDO 2,0 ; LOOK UP DIGIT AND SET FLAG C LDBT STORB OP ; AND OUTPUT IT NEWD1: LDA 2,CAD,3 ; ADDRESS OF TABLE LDA 2,1,2 ; LOW ORDER WORD MOVZR# 2,2,SZC ; LAST TABLE WORD ? JMP END ; YES. ISZ CAD,3 ISZ CAD,3 JMP LOOP1 END: MOV 0,0,SZC ; ANY DIGITS OUTPUT ?? JMP END1 ; YES ALL DONE LDA 1,ZERO ;  NO OUTPUT AT LEAST ONE STORB OP END1: SUB 1,1 ; STORE A FINAL NULL STORB OP LDA 2,SSOSP,3 ; RETURN POINTER TO NULL STA 0,SSAC0,2 RTRN ZERO: "0 HWAD: HW .RDX 16 ; HEX TABLE HTABL: .+1 10000000_D 1000000_D 100000_D 10000_D 1000_D 100_D 10_D 1_D .RDX 10 ; DECIMAL TABLE DTABL: .+1 ; DECIMAL TABLE 1000000000D 100000000D 10000000D 1000000D 100000D 10000D 1000D 100D 10D 1D .RDX 8 ; OCTAL TABLE OTABL:4 .+1 10000000000D 1000000000D 100000000D 10000000D 1000000D 100000D 10000D 1000D 100D 10D 1D .TXTM 1 OUTBL: .+1*2 .TXT *0123456789ABCDEF* ; ; DOUBLE PRECISION SUBTRACT ROUTINE ; 0 DSUB: MOV 0,2 ; DOUBLE PRECISION SUBTRACT MOV 1,3 LDA Ӕ0,0,3 LDA 1,1,3 LDA 3,0,2 LDA 2,1,2 SUBZ 2,1,SNC ADC 3,0,SKP SUB 3,0 LDA 3,USP LDA 3,SSOSP,3 STA 1,SSAC1,3 STA 0,SSAC0,3 RTRN MOVE.SR5  ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMOVE .RB CMOVE.RB ** .ENDC J .TITL BMOVE .RB BMOVE.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT MOVEFIL .EXTN GETAR ; GET ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN SETSW ; SET SWITCH ROUTINE .EXTN BFMVI ; BUFFER MOVE LINE IN .EXTN PCBUF ; PUT CHARACTER BUFFER .EXTN SBUFR ; SCRATCH BUFFER .EXTN CLBUF ; CLEAR BUFFER ROUTINE .EXTN LDBT STBT .EXTN LDBI STBI .EXTN" CALL RTRN RCALL .EXTN WRBIN .EXTN CMOVE .EXTN .INDEX INDEX .EXTN .ASCD ; ASCII TO DECIMAL CONVERSION .EXTN MOV2E ; MOVE PART 2 OVERLAY NUMBER .EXTN MOV2 ; MOVE PART 2 ENTRY ADDRESS .EXTN SWAPR ; SWAP OVERLAY ROUTINE ; DEFINE THE STACK ASW= 1 ; A^LL SWITCH KSW= ASW+1 ; NO LINK SWITCH CP= KSW+1 ; ARG POINTER STACK= CP ; STACK SIZE STACK MOVEF: ISZ SSRTN,2 ; SET GOOD RETURN C GETSW ; GET THE SWITCHES STA 0,CP,3 ; SAVE POINTER SW A K ; TEST SWITCHES LDA 0,CP,3 C GETAR ; GET OUTPUT DIRECTORY NAME JMP NOARG ; MUST HAVE OUTPUT FILE STA 0,CP,3 ; SAVE POINTER LDA 2,MOSBP ; CLEAR OUT NAME BUFFER C CLBUF SUB 0,0 SNZ ASW ; PERM FILES ? LDA 0,PERAT ; NO MASK THEM OUT LDA 2,DIRPAR ; NO DIRECTORY OF PARTITIONS ADD 2,0 SUB 2,2 SKZ KSW ; LINKS ?? LDA 2,LINAT ; NO MASK THEM OUT ADD 2,0 MOV 0,1 ; AC1 = INHIBIT MASK ADC 2,2 ; ANYTHING ELSE OK LDA 0,CP,3 ; AC0= ARG POINTER C MKNMS ; MAKE THE HIT LIST JMP FERTN ; TAKE ERROR RETURN LDA 2,SSOSP,3 ; TRAP TO SECOND HALF OF MOVE ROUTINEZ LDA 0,MOVOV ; AC0 = MOV2 OVERLAY NUMBER STA 0,SSAC0,2 ; STORE IT LDA 0,MOV2A ; AC2 = MOV2 ADDRESS STA 0,SSAC2,2 LDA 0,.SWAP ; TRAP TO SWAP ROUTINE STA 0,SSRTN,2 RTRN MOVOV: MOV2E ; OVERLAY # AND NODE MOV2A: MOV2 ; ENTRY ADDRESS .SWAP: SWAPR MOSBP: SBUFR ; POINTER TO SBUFF HEADER PERAT: ATPER DIRPAR: ATDIR+ATPAR LINAT: ATLNK NOARG: LDA 0,CP,3 LDA 2,ERARG ER1 3 NOP FERTN: LDA 3,SSOSP,3 ; TAKE ERROR RETURN DSZ SSRTN,3 RTRN ERARG: CNEAR ; DEFINE THE STACK ARGSW= 1 ; ARGUMENT SEEN SWITCH * ASW= ARGSW+1 ; ATTRIBUTES TO IGNORE OSW= ASW+1 ; ATTRIBUTES TO LOOK FOR SSW= OSW+1 ; LOCAL/S SWITCH IP= SSW+1 ; INPUT POINTER ADATE= IP+1 ; AFTER DATE BDATE= ADATE+1 ; BEFORE DATE NAMEP= BDATE+1 ; POINTER TO NAME BP= NAMEP+1 ; POINTER TO BUFF NAMEb= BP+1 ; SPACE FOR FILE NAMES BUFH= NAME+12 ; BUFFER HEADER ADDRESS BUFF= BUFH+2 ; BUFFER ADDRESS STACK= BUFF+401; STACK SIZE ** .DO CCOND SYSCH= PUSCH ** .ENDC J SYSCH= TMPCH **[J] STACK MKNMS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN STA 0,IP,3 ; SAVE INPUT POINTER STA 1,ASW,3 ; SAVE ATTRIBUTES OFF WORD LDA 2,SSAC2,2 ; SAVE ATTRIBUTES ON WORD STA 2,OSW,3 ADC 1,1 STA 1,BDATE,3 ; BEFORE TIME = END OF TIME STA 1,ARGSW,3 ; SET NO ARGUMENT FLAG CLER ADATE ; AFTER DATE = 0 MKNM0: STA 1,BP,3 ; SET/RESET ARG FLAG MKNM1: C GETAR ; GET NEXT ARGUMENT JMP MKNP2 ; NONE LEFT GO TO NEXT PASS C GETSW ; GET SWITCHES STA 2,SSW,3 ; SAVE SECOND SWITCH WORD MOVZL 1,1,SZC ; /A ? JMP AFTER ; YES PROCESS AFTER DATE MOVZL 1,1,SZC ; /B ? JMP BEFOR ; YES PROCESS BEFORE DATE LDA 3,K20 ; /N ?? AND# 3,1,SZR JMP MKNM1 ; YES DON'T ADD TO LIST C TDASH ; ARG HAVE - OR * ? JMP MKNM5 ; YES - SEE ABOUT S SWITCH LDA 2,.SBUFR ; NO ADD NAME TO BUFFER C BFMVI ISZ BFFFB,2 ; COUNT NULL LDA 1,SWUS ; MARK ENTRY  USED C SETSW CLER ARGSW ; SHOW WE HAD AT LEAST ONE ARGUMENT LDA 1,KSWN ; NOW MAKE NAME A /N FOR SYS.DR SEARCH C SETSW LDA 1,SSW,3 LDA 3,SS.W AND# 1,3,SNR ; /S LOCAL ?? JMP MKNM1 ; NO PROCESS NEXT ARGUMENT DSZ BFFFB,2 ; YES - CHANGE TRAILING NUMLL TO SPACE LDA 1,K40 C PCBUF C GETAR ; YES GET NEXT ARG JMP @.MKNNA ; ERROR MUST BE IN PAIRS C TDASH ; TEST FOR - OR * JMP MKNME ; NO - OR * ALLOWED HERE C BFMVI ; ALL APPEARS TO BE OK PUT ARG AWAY ISZ BFFFB,2 ; COUNT NULL MKNM4: LDA 1,KSWI ;7 KILL THIS ARG IN LIST C SETSW ; BY SETTING INVISABLE SWITCH JMP MKNM1 ; GET NEXT MKNM5: LDA 2,SSW,3 ; ARG HAD A - OR * LDA 1,SS.W AND# 1,2,SNR ; /S SET ? JMP MKNM0 ; NO COUNT THIS ARG AND CONTINUE MKNME: LDA 2,MNCIL ; YES - FLAG AS ILLEGAL ARGU/`MENT JMP MKEER ; BAIL OUT AFTER: C CNVRT ; CONVERT DAYS SICE 68 JMP FATER ; SOME TYPE OF ERROR STA 1,ADATE,3 JMP MKNM4 BEFOR: C CNVRT ; CONVERT TO DAYS SINCE 68 JMP FATER ; TRY AGAIN STA 1,BDATE,3 ; SAVE IT JMP MKNM4 ; CONTINUE SS.W: S.SW KSWN: ' 1B7+N.SW ; SWITCH WORD ONE, BIT 13 KSWI: 3B7+1 ; SWITCH WORD TWO, BIT 15 K20: 20 K40: 40 .SBUFR: SBUFR SWUS: 3B7+2 ; SWITCH WORD TWO, BIT 14 MNCIL: CILAR .MKNNA: MKNNA ; NOW PROCESS NORMAL ARGUMENTS MKNP2: LDA 1,ARGSW,3 LDA 0,BP,3 MOV 0,0,SZR ; ANYn - OR * ARGS SUB 1,1 ; YES DON'T WANT FORCE SWITCH STA 1,ARGSW,3 ADD 0,1,SNR ; NEED A SYS.DR SEARCH ? JMP NOARL ; NO TAKE A SHORT CUT BPT NAME NAMEP ; MAKE POINTER TO NAME SPACE BPT BUFF BP ; AND BUFFER MOV 1,0 ; SET UP POINTERS LDA 1,.SYSCH > C RDSIN ; OPEN UP SYS.DR JMP SYSER ; ;;;; FINI1: LDA 0,BP,3 ; GET FIRST ENTRY C RDSYS JMP REDER ; MAY BE END OF FILE LDA 0,ASW,3 ; CHECK FOR ATTRIBUTS MASK LDA 1,UFTAT,2 AND 1,0,SZR ; IF ANY OF THEM ON SKIP THIS ENTRY JMP FINI1 LDA 0,OSW,3 ; TEST ATTRIBUTES ON WORD COM# 0,0,SNR ; ALL CASE ?? MOV 0,1 ; YES INSURE A MATCH AND 1,0,SNR ; AT LEASE ONE OF THEM ON ?? JMP FINI1 ; NO SKIP THIS FILE MOVZL 2,0 ; SET POINTER LDA 1,ARGSW,3 ; ARGUMENT FLAG C CNAME ; NAME MATCH ?? JMP FINI1 ; NO TRY NE XT LDA 0,UFTAT,2 LDA 1,.ATLNK AND# 1,0,SZR ; A LINK ?? JMP FIND2 ; YES - LINKS HAVE NO TIME LDA 0,UFTYD,2 LDA 1,ADATE,3 SUBZ# 1,0,SNC ; TOO OLD ? JMP FINI1 ; YES SKIP IT LDA 1,BDATE,3 SUBZ# 1,0,SZC ; TOO YOUNG ? JMP FINI1 ; YES FORGET IT ALSO FIND2: LDA 0,NAMEP,3 C SNTUN LDA 2,.SBUFR C BFMVI ISZ BFFFB,2 ; COUNT FINAL NULL JMP FINI1 ; CONTINUE REDER: LDA 3,KEOF SUB# 3,2,SZR ; END OF FILE ?? JMP SYSER ; NO TOO BAD S CLOS SYSCH ; YES CLOS SYS.DR CHANNEL NOP NOARL: LDA 1,K200 ; STO RE TERMINATOR LDA 2,.SBUFR C PCBUF SUB 1,1 ; STORE A NULL C PCBUF LDA 0,IP,3 ; RESTORE ARG POINTER ENDE1: C GETAR ; GET NEXT ARGUMENT RTRN ; ALL FINISHED C GETSW ; GET SWITCHES MOVZR 2,2 MOVZR 2,2,SZC ; USED ?? JMP ENDE1 ; YES GET NEXT LDA. 2,.CSPER ; GIVE ERROR ER1 4 JMP ENDE1 ; CONTINUE JMP FATER ; SORRY ABOUT THAT K200: 200 .ATLNK: ATLNK .SYSCH: SYSCH KEOF: EREOF .CSPER: CSPER MSSYS: DIRN*2 MKNMA: CNEAR MKNNA: LDA 2,MKNMA ; NOT ENOUGH ARGENMENTS JMP MKEER SYSER: LDA 0,MSSYS ; REPO~NRT SYS.DR ERROR MKEER: ER1 1 JMP FATER FATER: LDA 3,SSOSP,3 ; WHOA DSZ SSRTN,3 S CLOS SYSCH ; CLOSE SYS.DR CHANNEL NOP RTRN NAMP= 1 ; POINTER TO SYSTEM NAME HIT= NAMP+1 ; HIT FLAG NOTF= HIT+1 ; NOT FLAG (/N) STACK= NOTF ; STACK LENGTH STACK CdNAME: STA 0,NAMP,3 ; SAVE POINTER TO SYS.DR ENTRY STA 1,HIT,3 ; SET/RESET HIT SWITCH CLER NOTF ; CLEAR NOT FLAG LDA 0,IP,2 ; GET ARGUMENT POINTER CNAM1: C GETAR ; GET AN ARGUMENT JMP CNAM2 ; END OF LIST GO TEST LDA 1,NAMP,3 ; COMPARE NAME C CMPNM J2MP CNAM1 ; NO MATCH TRY NEXT STA 1,HIT,3 ; MARK THE HIT C GETSW ; GET SWITCHES LDA 2,KNSW AND# 2,1,SZR ; /N ?? STA 2,NOTF,3 ; YES SET NOT FLAG LDA 1,CSWUS ; MARK IT USED C SETSW JMP CNAM1 ; GET NEXT CNAM2: LDA 1,HIT,3 LDA 0,NOTF,3 MOV 0,0,SN/R ; IF NOT GIVE NO MATCH RETURN MOV 1,1,SNR ; IF NO MATCH GIVE NO MATCH RETURN RTRN LDA 2,SSOSP,3 ; RESTORE SSOSP ISZ SSRTN,2 ; ELSE GIVE GOOD RETURN RTRN KNSW: N.SW CSWUS: 3B7+2 ;TDASH ; ROUTINE TO TEST ARGUMENT FOR - OR * ; ; CALLING SEQUENSE% ; LDA 0,(BYTE POINTER TO NAME) ; C TDASH ; (FOUND RETURN) ; FOUND * OR - ; (NOT FOUND RETURN) 0 TDASH: LDA 1,TDDAS C .INDEX ; A DASH ? JMP TDAS1 ; NO - TRY FOR STAR RTRN ; YES - RETURN TDAS1: LDA 1,TDSTA C .INDEX ; A STAR ? ISZ SSRTN,2 ; NO M‹ATCH BUMP RETURN RTRN TDDAS: "- TDSTA: "* ; ; INITIALIZATION FOR READING SYS.DR ; AC0 -> BUFFER (401 WORDS) ; AC1 = CHANNEL NUMBER ; CALL ; RDSIN ; -ERROR RETURN ; -NORMAL RETURN ; ; -2 CHANNEL# ; -1 CURRENT LOGICAL BLOCK# ; 0 ENTRY PTR ; 1 (BEG OF HBLK) ENTRY COUNT ; 2 FIRST ENTRY 0 RDSIN: ISZ SSRTN,2 MOVZR 0,2 SUB 0,0 STA 0,1,2 STA 0,-1,2 ; BEGIN WITH BLOCK 0 INCS 0,0 ; MAKE 400 ADD 1,0 ; CHANNEL+BLOCK INCREMENT STA 0,-2,2 MOV 1,2 LDA 0,DIRNP S ROPEN CPU JMP SERR RTRN DIRNP: .+1*2 DIRN: .TXT /SYS.DR/ SERR: LDA 3,SSOSP,3 DSZ SSRTN,3 STA 2,SSAC2,3 RTRN ; ; READ NEXT ENTRY FROM SYS.DR ; AC0 -> BUFFER ; AC2 = RETURNED ENTRY ADDRESS ; CALL ; RDSYS ; -ERROR OR EOF (CODE IN AC2) ; -NORMAL RETURN 0 RDSYS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN MOVZR 0,2 ; BUILD BUFFER ADDRESS .LOOP: LDA 0,1,2 MOV# 0,0,SZR JMP ENTF INC 2,0 LDA 1,-1,2 ISZ -1,2 LDA 2,-2,2 S RDB CPU JMP SERR NEG 0,2 COM 2,2 INC 0,0 STA 0,0,2 JMP .LOOP ENTF: LDA @0,0,2 ; NAME WORD MOVZ 0,0,SZR MOVO 0,0 ; SET 9CARRY IF NON VACENT LDA 0,ENTSZ LDA 1,0,2 ADD 1,0 STA 0,0,2 MOV# 0,0,SNC JMP .LOOP DSZ 1,2 JMP .+1 LDA 2,SSOSP,3 STA 1,SSAC2,2 RTRN ENTSZ: UFDEL ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2,2 ; MAKE A BYTE POINTER MOV 0,1 L(DA 0,LINEX C WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX: .+1*2 .TXT /^C.^W/ ; CMPNM ; ROUTINE TO COMPARE SYSTEM NAME WITH A USER NAME. ; AC1 POINTS TO THE SYSTEM NAME ; AC0 POINTS TO THE USER! NAME ; * WILL MATCH ANY SINGLE CHARACTER ; -(MINUS SIGN) WILL MATCH ANY NUMBER ; (INCLUDING 0) OF CHARACTERS ; CALL ; CMPNM ; - NO MATCH RETURN ; - MATCH RETURN SPNT =1 ; HOLDS POINTER TO SYSTEM NAME UPNT =SPNT+1 ; POINTER TO USER NAME SCNT =UPNT+1  ; # OF CHAR LEFT IN SYSTEM NAME UCNT =SCNT+1 ; # LEFT IN USER NAME TO PROCESS STXSX =UCNT ; STACK SIZE NEEDED FOR UNMSCN ROUTINE SEXT =UCNT+1 ; POINTS TO SYSTEM NAME EXTENSION STYSZ =SEXT ; STACK SIZE NEED FOR CMPNM ROUTINE STYSZ ; COMPARE SYSTEN NAME ROUTINE START ADDRESS ; ALL REGS ARE SAVED ON STACK ON ENTRY ; SAVE START ADDRESS OF NAMES FOR PROCESSING CMPNM: STA 0,UPNT,3 ; SAVE START OF USER NAME STA 1,SPNT,3 ; AND SYSTEM NAME TO MATCH LDA 0,C12 ; GET MAX SIZE OF NAME ADD 0,1 ; CALC ADDRESxS OF SYSTEM NAME EXTENXION STA 1,SEXT,3 ; AND SAVE IT ; SET IN THE MAX # OF CHARS ALLOWED IN SYSTEM AND USER NAMES STA 0,UCNT,3 ; SET THAT 12 IS HIGHEST STA 0,SCNT,3 ; ALLOWED ; SEE IF THE NAME MATCHES C NMSCN ; GO SCAN THE NAME RTRN ; IF NO MATCHyv THEN TELL OUR CALLER ELSE ; HAD A MATCH, CHECK IF USER NAME IS ALL DONE(IE ENDED IN ZERO BYTE) L1: LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE MATCH ENDED C LDBT ; GET CHAR MOV# 1,1,SNR ; IF IS ZERO THEN USER NAME IS DONE JMP L2 ; GO MAKE SURE SYhZSTEM NAME DOES NOT ; HAVE EXTENSION ISZ UPNT,3 ; INC TO NEXT CHAR POSITION IN USER NAME LDA 0,PER ; CHECK FOR PERIOD IN USER NAME INDICATING SUB# 0,1,SZR ; AN EXTENSION IS PRESENT, IF NOT THEN JMP L1 ; LOOP TO LOOK MORE AT STRING ELSE ; SET UP TO MATCH THE NAME EXTENSIONS LDA 0,SEXT,3 ; GET ADDRESS OF SYSTEM NAME EXTENSION STA 0,SPNT,3 ; AND SET TO SCAN LDA 0,C2 ; SET MAX SIZE OF EXTENSION STA 0,SCNT,3 ; TO BE 2 FOR USER AND SYSTEN STA 0,UCNT,3 ; NAMES ; SCAN THE EXTENSION FOR CORRECTNESS q C NMSCN ; SCAN THE EXTENSION RTRN ; GIVE UP ON NO MATCH ELSE JMP L3 ; WE HAVE NAMES THAT MATCH ; USER NAME HAS NO EXTENSION, CHECK IF SYSTEN NAME HAS EXTENSION L2: LDA 0,SEXT,3 ; GET ADDR OF EXTENSION C LDBT ; GET 1ST CHAR OF IT MOV# 1,1,SZR8 ; IF HAS EXTENSION THEN RTRN ; NO MATCH ELSE ; WE HAVE A NAME MATCH, RETURN TO CALLER AT MATCH ADDRESS L3: LDA 2,SSOSP,3 ; GET CALLER STACK POINTER ISZ SSRTN,2 ; INC RETURN POINTER TO MATCH ADDR RTRN ; RETURN TO CALLER PER: ". ; PERIOD SEPARATING FILE NAME FROM EXTENASION DASH: "- ; ANY LENGTH MATCH CHAR STAR: "* ; ANY CHAR MATCH C12: 12 ; # OF CHARS IN FILE NAMES C2: 2 ; # OF CHARS IN FILE NAME EXTENSIONS ; INTERNAME ROUTINE FOR "CMPNM" TO TRY FOR MATCH OF WHAT IS LEFT ; OF STRING. ON ENTRY A5C2 POINTS TO THE STACK OF THE CALLER ; WHICH CONTAINS WHERE THE CALLER WAS IN COMPARING THE 2 STRINGS. ; THIS ROUTINE STARTS AT WHERE THE CALLER LEFT OFF AND SCANS THE LINE ; IF NO MATCH THEN RETURNS TO CALLER AT CALL+1 WITH NOTHING CHANGED. ; IF MATCH THEN UPDATES THE USER POINTER IN THE CALLERS STACK TO ; POINT TO THE CHAR THAT ENDED THE COMPARE AND RETURNS AT CALL+2. ; IF ROUTINE ENCOUNTERS DASH THEN IT CALLS ITSELF WITH THE USER NAME ; POINTER POINTING TO THE CHAR AFTER THE DASH. IF ON RETURN IT HAS A ; MATCH THEN IT RETURNS TO ITS CALLER WITH A MATCH. IF NO MATCH THEN ; INCREMENTS THE SYSTEM NAME POINTER BY ONE AND CALLS ITSELF AGAIN. ; PROCESS CONTINUES TILL EITHER MATCH OR SYSTEM FILE NAME ; EXHAUSTED. STXSX ; ROUTINE STACK SIZE NMSCN: ; ROUTINE START ADDRESS ; COPY WHERE CALLER WAS AT IN SCAN TO OWN STACK LDA 0,SPNT,2 ; GET WHERE WAS AT IN SYSTEM NAME STA 0,SPNT,3 ; SAVE IN OWN STACK LDA 0,UPNT,2 ; GET WHERE AT IN USER NAME STA 0,UPNT,3 ; AND STORE LDA 0,SCNT,2 ; GET # CHARS MAX LEFT IN SY|STEM NAME STA 0,SCNT,3 ; AND STORE IT LDA 0,UCNT,2 ; SAME WITH USER NAME STA 0,UCNT,3 ; GET CHAR FROM EACH STRING TO MATCH NM1: LDA 0,UPNT,3 ; PICK UP CHAR FROM C LDBT ; USER STRING MOV 1,2 ; AND SAVE IN AC2 SUB 1,1 ; SET SYSTEM CHAR TO NULL ANDI LDA 0,SCNT,3 ; IF END OF SYSTEM STRING MOV# 0,0,SNR ; REACHED CHECK TO SEE JMP NM15 ; IF USER CHAR WAS NULL LDA 0,SPNT,3 ; ELSE PICK UP CHAR C LDBT ; FROM SYSTEM STRING ; CHECK TO SEE IF THEY ARE EQUAL NM15: SUB# 1,2,SZR ; IF NOT EQUAL THEN JMP NM3 ; BRANCH ELSE ; WE HAVE MATCH, SEE IF MATCH IS THAT OF END OF STRINGS MOV# 2,2,SNR ; IF WE ARE AT END OF STRINGS THEN JMP NM5 ; NAMES MATCH ELSE ; NAMES NOT ALL MATCHED YET, CHECK TO SEE IF HAVE REACHED END OF ; WHAT SHOULD BE PROCESSED IN NAMES NM2: ISZ UPNT,3 ; UPDATE NAME POINTERS TO ISZ SPNT,3 ; NEXT CHAR DSZ SCNT,3 ; COUNT SYSTEM NAME CHAR NOP DSZ UCNT,3 ; IF HAVE NOT MATCHED MAX # USER JMP NM1 ; CHARS THAN GET NEXT CHAR ELSE JMP NM5 ; WE HAVE COMPLETE MATCH ; CHARS DID NOT MAyTCH, CHECK FOR SPECIAL CHARS NM3: LDA 0,PER ; IF USER NAME CHAR IS A SUB# 0,2,SNR ; PERIOD THEN IS END OF USER JMP NM4 ; USER NAME SO BRANCH ELSE LDA 0,DASH ; IF IS DASH THEN GO SUB# 0,2,SNR ; WHAT PART OF REST OF SYSTEM NAME JMP NM9 ; MATCH USEZR NAME ELSE LDA 0,STAR ; IF IS STAR AND THE SYSTEM SUB# 0,2,SNR ; NAME CHAR IS NOT A ZERO THEN MOV# 1,1,SNR ; SAY THE CHARS MATCH ELSE RTRN ; RETURN WITH NO MATCH JMP NM2 ; FOUND PERIOD IN USER NAME, CHECK THAT SYSTEM NAME IS ENDED NM4: MOV# 1,1,SZR ; IF SYSTEM NAME DID NOT END AT RTRN ; SAME POINT AS USER THEN NO MATCH ELSE ; NAMES DO MATCH, RETURN ADDRESS OF WHERE MATCH ENDED IN USER NAME ; TO CALLER. NM5: LDA 2,SSOSP,3 ; GET ADDRESS OF CALLER STACK LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE ENDED STA 0,UPNT,2 ; RETURN TO CALLER ; INC RETURN ADDR TO SUCCESSFUL RETURN ADRESS AND DONE ISZ SSRTN,2 RTRN ; FOUND DASH IN USER NAME, INC PAST THE DASH NM9: ISZ UPNT,3 ; CHECK, IF DASH WAS LAST CHAR OF NAME THEN WE HAVE A MATCH LDA 0,UPNT,3 Y; GET POINTER TO USER NAME C LDBT ; GET NEXT CHAR OF NAME LDA 0,PER ; IF IT IS ENDED THEN SUB# 0,1,SZR ; WE HAVE A MATCH ELSE MOV# 1,1,SNR ; WE HAVE NO MATCH JMP NM5 ; MATCH ; SEE IF WHAT IS LEFT OF USER NAME MATCHES WHATS LEFT OF SYSTEM NAME NM10: C NMSCN ; SCAN NAMES FOR MATCH MOV# 1,1,SKP ; IF NO MATCH THEN SKIP ELSE JMP NM5 ; IF MATCH THEN WOOPY, GO RETURN SUCCESS ; DOES NOT MATCH, SEE IF ANYTHING LEFT OF SYSTEM NAME TO TRY MATCH ISZ SPNT,3 ; INC SYSTEM NAME POINTER TO NEXT CHAR DSZ  ARGUMENT LDA 2,.ERTIM ; TIME ERROR MESAGE ER1 3 ; GIVE ERROR MESSAGE RTRN ; ALLm ERRORS ARE FATAL RTRN MTBL: .+1 31. -1 31. 30. 31. 30. 31. 31. 30. 31. 30. 31. CM3: -3 MONTD: MONTH K1968D: 1968. K68D: 68. K14: 14. K12: 12. CM366: -366. .ERTIM: ERTIM PARTH.SR5  ; ; PARTITION AND DIRECTORY HANDLERS ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CPARTH .RB CPARTH.RB ** .ENDC J .TITL BPARTH .RB BPARTH.RB **[J] .NREL .TXTM 1 ; PACK EM) LEFT TO RIGHT .ENT LINK ; CREATE A LINK ENTRY .ENT GDIR ; PRINT NAME OF THE CURRENT DIRECTORY .ENT MDIR ; PRINT NAME OF MASTER DIRECTORY .ENT GSYS ; PRINT NAME OF CURRENTLY RUNNING SYSTEM .ENT GMEM ; GET/SET MEMORY ALLOCATION FOR FG & BG ** .DO CCOܻND .ENT EQUIV ; EQUIVALENCE A NEW NAME TO A DIRECTORY (DEVICE) .ENT CDIR ; CREATE A SUBIRECTORY .ENT LDIR ; PRINT NAME OF PREVIOUS DIRECTORY .ENT SMEM ; SET MEMORY ALLOCATION FOR FG AND BG .EXTN LSTDR ; BYTE POINTER TO PREVIOUS DIRECTORY ** .ENDC **  .EXTN CALL RTRN LDBT .EXTN WRLIN ERR1 ERR2 .EXTN GETARG GETSW .ASCDB ; ; CREATE A LINK ENTRY ; ; DEFINE THE STACK CP= 1 STAK= CP ** .DO BCOND DIR= CP+1 STAK= DIR ** .ENDC STAK LINK: ISZ SSRTN 2 LINK1: C GETARG ; GET FIRST ARGUMENT RTRN ; NO ={ARGUMENT MOV 0,2 C GETARG ; GET SECOND ARGUMENT JMP NOARG STA 0,CP,3 ; UPDATE COMMAND PTR MOV 0,1 MOV 2,0 S LINK ; PERFORM LINK JMP LNER LDA 0,CP,3 JMP LINK1 ; RECYCLE ; ERROR HANDLING LNER: ER1 3 RTRN ERTN: LDA 2,SSOSP,3 DSZ SSRTN,2 RTRN NOARG: LDA 2,NOAR ERX: ER2 3 RTRN JMP ERTN NOAR: CNEAR ** .DO CCOND ; ; EQUIV A NAME TO DIRECTORY SPECIFIER ; ; DEFINE THE STACK EQCP= 1 OLDNA= EQCP+1 NEWNA= OLDNA+1 NEWNA EQUIV: ISZ SSRTN,2 STA 0,EQCP,3 ; SAVE ARG POINTER C GETAR ; GET NEW WNAME RTRN ; TA TA STA 0,NEWNA,3 ; SAVE NEW NAME C GETAR JMP NOARG ; NO SECOND ARG VERY BAD STA 0,OLDNA,3 ; SAVE AS OLD NAME LDA 0,EQCP,3 ; GET ARG POINTER AGAIN C GETSW ; GET THE SWITCHES LDA 0,PS.W ; P SWITCH AND# 0,1,SZR ; SWITCH SET ? JMP EQPAU ; YES - THE PAUSE THAT REFRESHES EQUI1: LDA 0,OLDNA,3 ; OLD NAME LDA 1,NEWNA,3 ; NEW NAME S EQIV ; EQIV IT JMP ERX RTRN ; TA TA EQPAU: LDA 0,MSPAU ; SEND PAUSE MESSAGE C WRLIN NEWNA OLDNA S GCHAR ; WAIT FOR USER NOP JMP EQUI1 MSPAU: .+Ȩ1*2 ** .NOLOC 1 .TXT /MOUNT ^C ON UNIT ^C, STRIKE ANY KEY<15>/ ** .NOLOC 0 PS.W: P.SW ; ; CREATE A SUBDIRECTORY ; 0 CDIR: ISZ SSRTN,3 CDIR1: C GETARG ; GET THE NAME RTRN S CDIR ; CREATE THE DIRECTORY JMP LNER JMP CDIR1 ** .ENDC ; ; GET THE CURRENT DIRECTORY NAME ; ; DEFINE THE STACK NMSP= 1 NMS= NMSP+1 NMSIZ= SCFNL+1 STSIZ= NMSP+NMSIZ STSIZ GDIR: ISZ SSRTN,2 LDA 0,NMAD ADDZL 3,0 ; MAKE PTR TO NAME AREA STA 0,NMSP,3 S GDIR JMP LNER OUTNM: LDA 0,LINP ; POINT TO OUTPUT FORMAT C WRLIN .0 ; AND WRITE OUT THE INFO. NMSP RTRN NMAD: NMS LINP: .+1*2 ** .NOLOC 1 .TXT /^C<15>/ ** .NOLOC 0 ; ; GET THE NAME OF THE MASTER DIRECTORY ; STSIZ MDIR: ISZ SSRTN,2 LDA 0,NMAD ; GET NAME OF MASTER DIRECTORY ADDZL 3,0 ; MAKE PTR TO PLACE FOR IT STA 0,NMSP,3 S MDIR JMP LNER ; GO REPORT ERROR JMP OUTNM ; GO PRINT IT ; ; GET THE SYSTEM NAME ; STSIZ GSYS: ISZ SSRTN,2 LDA 0,NMAD ; GET NAME OF SYSTEM RUNNING NOW ADDZL 3,0 ; PTR TO PLACE FOR TEXT STA 0,NMSP,3 S GSYS ; GET SYSTEM NAME JMP LNER jMOVZR 0,2 ; FORM WORD POINTER TO NAME SUB 0,0 ; NULL STA 0,UFTEX,2 ; WIPE OUT EXTENSION. JMP OUTNM ; GO PRINT IT ** .DO CCOND==1 ; ; GET THE NAME OF THE PREVIOUS DIRECTORY ; NMSP LDIR: ISZ SSRTN,2 ; SET OK RETURN LDA 0,.LSTDR ; PICK UP POINTER TO PREV DIRECTORY STA 0,NMSP,3 ; AND STORE IT IN STACK JMP OUTNM ; GO PRINT IT .LSTDR: LSTDR ** .ENDC ; ; GET/SET MEMORY ALLOCATION TO FOREGROUND AND BACKGROUND ; AC0 - BG: (DECIMAL) NUMBER OF 1K BLOCKS ; AC1 - FG: " " " ; EXECUTABLE IN MAPPED SYSTEMS >ONLY ; 0 GMEM: ISZ SSRTN,2 S GMEM ; GET MEMORY ALLOCATIONS JMP ERX MOV 0,2 LDA 0,GLIN C WRLIN ; WRITE IT OUT SSAC2 SSAC1 RTRN ; THAT'S ALL ** .DO CCOND 0 SMEM: ISZ SSRTN,2 ; SET GOOD RETURN C GETARG ; GET MEM ALLOCATION SIZE JMP NOARG ; NEGED AT LEAST ONE ARGUMENT C .ASCDB ; CONVERT INPUT TO BINARY JMP @.ERX ; SOMETHING WRONG WITH INPUT MOV 1,0 ; AC0 <= DESIRED BG MEM ALLOCATION S SMEM ; SET MEMORY ALLOCATION JMP @.ERX ; INVALID ALLOCATION RTRN ; THAT'S ALL .ERX: ERX ** .ENDC GLIN:< .+1*2 ** .NOLOC 1 .TXT /BG: ^D FG: ^D<15>/ ** .NOLOC 0 CLIPARS.SR5 0c ; DEFINE THE CONDITIONALS .DUSR NO.MAC= 1 ; DON'T LIST MACROS .DUSR NO.CON= 1 ; DON'T LIST CONDITIONAL CODE .DUSR CCOND= 1 ; ASSEMBLE FOR CLI .DUSR BCOND= 0 ; DEFINE THE STACK DISPLACEMENTS .DUSR SSLGT= -7 ; VARIABLE LENGTH OF CALLING'S FRAME .DUSR SSOSP= -6 ; PREVIOUS STACK POINTER .DUSR SSRTN= -5 ; RETURN ADDRESS OF CALLING PROGRAM .DUSR SSEAD= -4 ; ENTRY ADDRESS OF CALLED ROUTINE .DUSR SSCRY= -3 ; CARRY .DUSR SSAC0= -2 ; SAVE STORAGE FOR CALLING'S ACCUMULATORS .DUSR SSAC1= -1 .DUSR SSAC2= 0 ; (DON'T MODIFY THIS DISPLACEMENT!!) ; DEFINE THE BUFFER HEADERS .DUSR BFADR= 0 ; FIRST BYTE ADDRESS OF BUFFER .DUSR BFRPT= 1 ; RUNNING LOGICAL BYTE POINTER .DUSR BFFBT= 2 ; LOGICAL FIRST BYTE OF CURRENT PAGE .DUSR BFMOD= 3 ; BLOCK MODIFIED FLAG <>0 MODIFIED .DUSR BFFFB= 4 ; LOGICAL FIRST FREE BYTE ADDRESS .DUSR BFFIL= 5 ; FILE NAME FOR THIS BUFFER .DUSR BFCHN= 6 ; CHANNEL NUMBER 1B0 IF NOT OPEN .DUSR BFBDP= 7 ; STACK DISPLACEMENT TO BUFFER .DUSR BFNAM= 10 ; NAME FOR THIS BUFFER .DUSR BFNDP= 11 ; STACK DISPLACEM^ENT TO NAME POINTER ; DEFINE THE CHANNELS .DUSR CIN= 0 ; CONSOLE INPUT CHANNEL .DUSR COUT= 1 ; CONSOLE OUTPUT CHANNEL .DUSR COMCH= 2 ; COM.CM CHANNEL .DUSR PUSCH= 3 ; PUSH CHANNEL .DUSR TCHAN= 4 ; TEMP FILE CHANNEL .DUSR CCHAN= 5 ; COMMAND FILE CHANNELr .DUSR INSCH= 6 ; INSERT CHANNEL .DUSR CH1= 7 ; CHANNELS FOR UTILITIES .DUSR CH2= 10 .DUSR CH3= 11 .DUSR SCHAN= 12 ; SCRATCH FILE CHANNEL .DUSR KCH= 13 ; SPY CHANNEL .DUSR OVCH= 14 ; OVERLAY CHANNEL .DUSR ERCH= 15 ; ERROR FILE CHANNEL ; DEFINE SOME CHARACTERS .DUSR EOT= 4 ; END OF FILE CHARACTER .DUSR EOL= 15 ; END OF LINE CHARACTER .DUSR SEMI= "; ; ALSO END OF LINE CHARACTER .DUSR LF= 12 ; LINE FEED ; DEFINE THE FILE SYS DISPLACEMENTS .DUSR ISTAT= 0 ; AREA FOR STATS .DUSR IREAD= ISTAT+UFDEL ; READ ROUTINE ADDRESS .DUSR IWRIT= IREAD+1 ; WRITE ROUTINE ADDRESS .DUSR IBLOC= IWRIT+1 ; BLOCK NUMBER .DUSR IFLAG= IBLOC+1 ; FLAGS .DUSR ICBLK= IFLAG+1 ; LAST BLOCK WRITTEN .DUSR IPOIN= ICBLK+1 ; CURRENT POINTER .DUSR ISIZE= IPOIN+1 ; BLOCK SIZE .DUSR ICOUN= ISIZmE+1 ; REMAINING COUNT .DUSR IBUFP= ICOUN+1 ; BUFFER POINTER .DUSR ICHAN= IBUFP+1 ; PHYSICAL CHANNEL NUMBER .DUSR IBUFF= ICHAN+1 ; BUFFER FIRST WORD .DUSR CFSIZ= IBUFF ; SIZE OF BUFFER HEADER ; DEFINE SOME CONSTANTS .DUSR NOP= 401 ; JMP .+1 ; DEFINE THE 3CLI ERROR CODES .DUSR CNEAR= 300 ; NOT ENOUGH ARGUMENTS .DUSR CILAT= 301 ; ILLEGAL ATTRIBUTE .DUSR CNDBD= 302 ; NO DEBUG ADDRESS .DUSR CCLTL= 303 ; COMMAND LINE TOO LONG .DUSR CNSAD= 304 ; NO STARTING ADDRESS .DUSR CCKER= 305 ; CHECKSUM ERROR .DUSR CNSFS=8C 306 ; NO SOURCE FILE SPECIFIED .DUSR CNACM= 307 ; NOT A COMMAND .DUSR CILBK= 310 ; ILLEGAL BLOCK TYPE .DUSR CSPER= 311 ; NO FILES MATCH SPECIFIER .DUSR CPHER= 312 ; PHASE ERROR .DUSR CTMAR= 313 ; TOO MANY ARGUMENTS .DUSR CTMAD= 314 ; TOO MANY ACTIVE DEVICʫES .DUSR CILNA= 315 ; ILLEGAL NUMERIC ARGUMENT .DUSR CSFUE= 316 ; FATAL SYSTEM UTILITY ERROR .DUSR CILAR= 317 ; ILLEGAL ARGUMENT .DUSR CCANT= 320 ; IMPROPER OR MALICIOUS INPUT .DUSR CTMLI= 321 ; TOO MANY LEVELS OF INDIRECT FILES .DUSR CSYER= 322 ; SYNTAX EVVRROR .DUSR CBKER= 323 ; BRACKET ERROR .DUSR CPARE= 324 ; PAREN ERROR .DUSR CCART= 325 ; < WITHOUT > OR > WITHOUT < .DUSR CCAR1= 326 ; ILLEGAL NESTING OF <> AND () .DUSR CINDE= 327 ; ILLEGAL INDIRECT FILENAME .DUSR CPAR1= 330 ; ILLEGAL NESTING OF () AND [] A .DUSR CIVAR= 331 ; ILLEGAL VARIABLE .DUSR CILTA= 332 ; ILLEGAL TEXT ARGUMENT .DUSR CTATL= 333 ; TEXT ARGUMENT TOO LONG .DUSR CCMAX= CTATL ; MAX CLI ERROR CODE .DUSR ERML= 30. ; MAXIMUM ERROR MESSAGE LENGTH .MACRO C ; CALL MACRO CALL ^1 ** K=2 ** .DO '.ARGCT-1 ^K ** K=K+1 ** .ENDC % .MACRO S ; SYSTEM CALL MACRO .SYSTM .^1 ^2 % .MACRO SW ; TEST SWITCH MACRO ** K=1 ** .DO .ARGCT ; DO FOR EACH SWITCH IN CALL ** .DO "^K>="Q ; SWICH IN SECOND WORD ? ** L=2 ; YES USE AC2 ** .ENDC M ** L=1 ; NO USE AC1 ** [M] LDA 0,.+2 ; AC0=SWITCH BIT AND L,0,SKP ; TEST SWITCH ^K.SW STA 0,^KSW,3 ; STORE RESULT ** K=K+1 ** .ENDC % .MACRO BPT ; FORM BYTE POINTER TO FIRST ARG OF PAIR ** K=1 ; AND STORE IT IN SECOND ARG OF PAIR ** .DO .ARGCT/2 ; ARGS ARE STACK (DISPLACEMENTS LDA 1,.+2 ; AC1 = DISPLACEMENT ADDZL 3,1,SKP ; MAKE IT BYTE POINTER ^K ** K=K+1 STA 1,^K,3 ; STORE BYTE POINTER ** K=K+1 ** .ENDC % .MACRO PT ** K=1 ** .DO .ARGCT LDA 1,.+2 ADDZ 3,1,SKP ^K+1 STA 1,^K,3 ; (^K)=^K+SSP+1 ** K=K+1 ** .;ENDC % .MACRO CLER SUBC 1,1 ** K=1 ** .DO .ARGCT STA 1,^K,3 ** K=K+1 ** .ENDC % .MACRO SNZ LDA 1,^1,3 MOV# 1,1,SNR % .MACRO SKZ LDA 1,^1,3 MOV# 1,1,SZR % .MACRO ER1 .EXTN ERR1 ** .DO BCOND .EXTN EOP^1 LDA 3,.+2 ADD 3,2,SKP EOP^1 ** .ENDQC C ERR1 ; PUT OUT THE ERROR % .MACRO ER2 .EXTN ERR2 ** .DO BCOND .EXTN EOP^1 LDA 3,.+2 ADD 3,2,SKP EOP^1 ** .ENDC C ERR2 % .MACRO SETVR LDA 0,VS$ AND 2,0,SZR ; /V ?? LDA 0,VC$ ; YES SET UP CHANNEL # ** .DO BCOND JMP EX$ ; SKIP OVER CONSTANTS ** .ENDC ** .DO CCOND ; ONLY FOR CLI LDA 2,LS$ AND# 2,1,SNR ; /L ?? JMP EX$ ; NO EXIT LDA 2,LC$ ; YES OPEN UP $LPT LDA 0,LP$ SUB 1,1 S OPEN CPU SUB 2,2 MOV 2,0 JMP EX$ ; SKIP OVER MESS VC$: COUT ; VERIFY TO TTY LS$: L.SW ; L SWITCMH BIT LC$: CH1 ; $LPT CHANNEL LP$: .+1*2 .TXT /$LPT/ ** .ENDC J VC$: SOUT **[J] VS$: V.SW EX$: LDA 3,USP STA 0,^1,3 ; STORE VERIFY CHANNEL NUMBER % .MACRO WRVER ** .DO CCOND LDA 1,^1,3 C WRLCH ** .ENDC J C WRLIN ** [J] ** K=2 ** .DO .ARGCT-1 ^K *q* K=K+1 ** .ENDC % .MACRO LOG ** .EXTN SPYF ** .EXTN LOGER LDA 2,@.+8. ; SPY ON ?? MOV 2,2,SNR JMP .+4 ; NO- SKIP IT S WRL KCH ; YES- WRITE THE LINE JMP @.+2 ; FATAL LOG FILE ERROR JMP .+3 ; OK- CONTINUE LOGER SPYF % .MACRO DISP LDA 2,^1 hLDA 0,0,2 ; LOAD A CHAR FROM TABLE INC 2,2 ; BUMP POINTER COM# 0,0,SZR ; MATCH ALL ? SUB# 1,0,SNR ; MATCH ? JMP @0,2 ; YES YES INC 2,2 JMP .-6 % .MACRO ADI ** .DO ^1 INC ^2,^2 ** .ENDC % .MACRO SBI ** .DO ^1<>0 NEG ^2,^2 ** .DO ^1-1 INC ^2,^2 DELETE MESSAGE SNZ DUSW ; LINK ?? LDA 0,LKMS ; YES AC0 => UNLINK MESSAGE WRVER VERIF SSAC2 ; WRITE MESSAGE TO PROPER PLACE JMP LOOP ULNK: S ULNK ; TR;Y TO UNLINK IT JMP DLERR ; TOO BAD JMP DOIT2 ; SEE IF VERIFY NEEDED ** .DO CCOND ; ONLY FOR CLI CFIRM: MOV 0,2 ; SAVE FILE NAME LDA 0,CFMS ; SEND FILE NAME C WRLIN SSAC2 LDA 0,RESPP,3 ; READ ONE BYTE RESPONSE SUBZL 1,1 CFIR1: S RDS SICH JMP CFI5R1 C LDBT ; GET RESPONSE LDA 0,CR SUB 0,1 LDA 0,MSSS MOV 1,1,SZR ; CR ?? INC 0,0 ; NO JUST SEND CARRET C WRLIN MOV 1,1,SZR ; GET RID OF IT ?? JMP LOOP ; NO GET NEXT MOV 2,0 ; YES RESTORE NAME JMP DOIT1 ; GO TO IT ** .ENDC FRET: LDA 2Q,SSOSP,3 ; SET ERROR RETURN DSZ SSRTN,2 RET: ** .DO CCOND LDA 2,VERIF,3 LDA 1,LCHKD SUB# 1,2,SZR ; LINE PRINTER OPEN ?? RTRN ; NO RETUURN S CLOS CPU ; YES CLOSE IT NOP ** .ENDC RTRN ; RETRUN DLERR: ER1 4 ; GIVE ERROR JMP LOOP JMP FRET ** .DO CCOND CR: 15 MSSS: MSSSS*2 LCHKD: LCH ** .ENDC ** .NOLOC 1 ; SAVE SOME PAPER DLMS: .+1*2 .TXT /DELETED ^C<15>/ LKMS: .+1*2 .TXT /UNLINKED ^C<15>/ ** .DO CCOND CFMS: .+1*2 .TXT /^C: / MSSSS: .TXT /*<15>/ ** .ENDC ** .NOLOC 0 0 GARBU: LD A 2,SSAC2,2 ; GET BUFFER ADDRESS C BFMVO ; MOVE ARG TO USER SPACE LDA 2,SSOSP,3 ; RESTORE STACK POINTER STA 0,SSAC0,2 ; RETURN POINTER TO CALLER LDA 0,SSAC1,2 ; GET FIRST BYTE OF ARG C LDBT LDA 0,C200 SUB# 0,1,SZR ; END OF FILE ?? ISZ SSRTN,2 ; @NO GIVE NORMAL RETURN RTRN C200: 200 ; END OF FILE INDICATOR CNVRT.SR5 V  ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CCNVRT .RB CCNVRT.RB ** .ENDC J .TITL BCNVRT .RB BCNVRT.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CNVRT .EXTN CALL RTRN LDBT STBT LDBI STBI .EXTN INDEX ; INDEX ROUTINE .EXTN .ASCD ; CONVERT ASCII TO DECIMAL TMP= 1 ; TEMP MONTH= TMP+1 ; MONTH/DAY/YEAR DAY= MONTH+1 YEAR= DAY+1 FEB= YEAR+1 ; FEBUARY DATE= FEB+1 ; ACCUMULATED DATE STACK= DATE ; STACK LENGTH * STACK CNVRT: ISZ SSRTN,2 ; ASSUME GOOD RETURN LDA 2,CM3 ; THREE ARGS STA 2,TMP,3 ; SET COUNTER LDA 2,MONTD ; POINT TO MONTH ADD 3,2 CNVR0: C .ASCD ; CONVERT TO BINARY JMP NUMER ; SOME TYPE OF ERROR STA 1,0,2 ; SAVE VALUE INC 2,2 ; POINT TO NEXT  %ISZ TMP,3 ; DONE WITH THREE ? JMP CNVR1 ; NO CONTINUE JMP CNVR2 ; YES GO PROCESS CNVR1: LDA 1,DASH ; POINT TO NEXT ARGUMENT C INDEX JMP NUMER ; TRY AGAIN INC 0,0 JMP CNVR0 ; NO CONVERT NEXT CNVR2: LDA 1,YEAR,3 ; YES GET YEAR LDA 0,K1968D ; TRY TO TAKE OUT 1968 SUBZ# 0,1,SNC ; COME OUT ?? LDA 0,K68D ; NO TRY 68 SUBZ 1,0,SEZ JMP NUMER ; BAD YEAR STA 0,YEAR,3 ; SAVE YEAR MOVZR 0,1,SNC ; A LEAP YEAR PERHAPS ? MOVR 1,1 LDA 2,K14 ; IF SO ADD DAY TO FEB MOVCL 2,2 STA 2,FEB,3 LDA 2,K12 LDAB 1,MONTH,3 MOV 1,1,SZR SUBZ# 1,2,SNC ; LEGAL MONTH ?? JMP NUMER ; NO PUNISH LDA 2,MTBL SUB 0,0 ; CLEAR RESULT WORD CNVR3: LDA 1,0,2 ; AC1= DAYS TO THIS MONTH COM# 1,1,SNR ; FEB PERHAPS ?? LDA 1,FEB,3 ; YES GET IT DSZ MONTH,3 ; DONE ? JMP CNVR4 ; eNO ADD THIS MONTH JMP DAYS ; YES GO TO DAYS CNVR4: ADD 1,0 INC 2,2 ; BUMP POINTER JMP CNVR3 ; CONTINUE DAYS: LDA 2,DAY,3 ; GET DAYS SUBZ# 2,1,SNC ; DAYS LEGAL ? JMP NUMER ; SHAME ON YOU ADD 2,0 ; YES ADD THEM IN STA 0,DATE,3 ; SAVE DATE YEARS: LDA 0,YEAR,3 ; GET YEAR YEAR1: MOVZ 0,0,SNR ; ZER0 ? JMP FINI ; YES ALL DONE INC 0,0 ; NO BUMP YEAR LDA 2,CM366 ; 365 DAYS PER LEAP YEAR MOVZR 0,1,SNC ; IS IT LEAP YEAR MOVR 1,1,SZC INC 2,2 ; NO MAKE IT 365 DAYS NEG 2,2 LDA 1,DATE,3 ADD 1,2 STA 2,DATE,3 JMP YEAR1 ; CONTIUE FINI: LDA 2,SSOSP,3 ; RETURN DATE TO CALLER LDA 1,DATE,3 STA 1,SSAC1,2 RTRN NUMER: LDA 3,SSOSP,3 DSZ SSRTN,3 LDA 0,SSAC0,3 ; AC0 => ARGUMENT LDA 2,.ERTIM ; TIME ERROR MESAGE ER1 3 ; GIVE ERROR MESSAGE RTRN ; ALL ERRORS ARE FATAL RTRN MTBL: .+1 31. -1 31. 30. 31. 30. 31. 31. 30. 31. 30. 31. CM3: -3 DASH: "- MONTD: MONTH K1968D: 1968. K68D: 68. K14: 14. K12: 12. CM366: -366. .ERTIM: ERTIM CLEAR.SR5 V6H ;CLEAR ; ROUTINE TO CLEAR THE USE COUNT IN ONE OR MORE SYS.DR ENTRIES ; CLEAR FILE1 FILE2 [FILE3 ... ] CLEARES THE SPECIFIC FILES ; CLEAR/A CLEARS ALL FILES IN THE CURRENT DIRECTORY ; EXCEPT . . . . ; CLI.OL CLI.ER IF THEY ARE THE CURENT ONES ; THE SYST EM OVERLAYS AND TUNING FILE IF IN ; THE MASTER DIRECTORY ; LOG.CM IN ANY DIRECTORY ; THE DEVICES IN ANY DIRECTORY ; CLEAR/A/D DOES ALL THAT CLEAR/A DOES AND ; ALSO CLEARS THE DEVICES ; GLOBAL/V SWITCH CAUSES ALL THE CLEARED FILES TO ; BE LISTED TO THE SYSTEM OUTPUT DEVICE ; GLOBAL/L SWITCH CAUSES ALL THE CLEARED FILES TO ; BE LISTED TO THE LINE PRINTER ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CCLEAR .RB CCLEAR.RB ** .ENDC J .TITL BCLEAR .RB BCLEAR.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CLEAR ; CLEAR USE COUNTS IN SYS.DR .EXTN CALL RTRN COMP WRLCH .EXTN GETAR GETSW CLIDR RDSIN RDSYS .EXTN CSNAM SNTUN MKNAM WRLCH WRLIN ** .DO CCOND SICH= CIN SOCH= ҲCOUT SCH= PUSCH LCH= CH1 ** .ENDC J SICH= SIN SOCH= SOUT SCH= COMCH LCH= SOUT ** [J] CP=1 ; ARGUMENT POINTER ASW=CP+1 ; ALL SWITCH DSW=ASW+1 ; DEVICE SWITCH VERIF=DSW+1 ; VERIFY FLAG NAME=VERIF+1 ; SPACE FOR CURRENT NAME NAMP=NAME+7 ; POINTEHR TO NAME SYSN=NAMP+1 ; STORAGE FOR SYSTEM NAME SYSP=SYSN+7 ; POINTER TO SYSN TUNE=SYSP+1 ; SPACE FOR TUNE FILE NAME TUNP=TUNE+7 ; POINTER TO TUNE TABL=TUNP+1 ; POINTER TO AND TABLE TABLS=TABL+20 ; POINTER TO START OF TABLE DEVIC=TABLS+1 ; SYS.DR DEJaVICE CODE BUFP=DEVIC+1 ; BUFFER POINTER BHEAD=BUFP+1 ; BUFFER HEADER BUFF=BHEAD+3 ; MAIN BUFFER STACK=BUFF+SCDBS+1 STACK CLEAR: ISZ SSRTN,2 ; BUMP RETURN STA 0,CP,3 ; SAVE COMMAN POINTER C GETSW ; GET GLOBAL SWITCHES SW A D ; TEST ALL AND DEV;.ICE SWITCHES SETVR VERIF ; TAKE CARE OF VERIFY STUFF SNZ ASW ; ALL ? JMP @.LOOP ; NO JUST DO ARGS BPT NAME NAMP ; FORM BYTE POINTER TO NAME BPT BUFF BUFP ; BUFFER BPT SYSN SYSP ; SYSTEM NAME BPT TUNE TUNP ; TUNE FILE NAME PT TABL ; &FORM POINTER TO TABL STA 1,TABLS,3 ; SAVE START OF TABLE LDA 0,NAMP,3 ; GET DIRECTORY NAME S GDIR ; GET DIRECTORY NAME JMP ER2X LDA 1,.CLIDR ; AC1=> CLI DIRECTORY NAME C COMP ; THIS WHERE CLI IS HIDEING JMP CLIHP ; TAG YOUR IT ! CLEA1: LDA 0,BUFP,3 ; NOBODY USING BUFF NOW S MDIR ; GET MASTER DIRECTORY JMP ER2X LDA 1,NAMP,3 ; AC1 => DIRECTORY NAME C COMP ; IN MASTER ??? JMP MASTR ; YES SAVE SYS.OL CLEA2: LDA 0,SYSDR ; ADD SYS.DR TO LIST STA 0,@TABL,3 ISZ TABL,3 ; BUMP POINTER ISZ TABL,3 Y/LDA 0,LOGCM ; AND ADD LOG.CM STA 0,@TABL,3 ISZ TABL,3 ISZ TABL,3 ADC 1,1 ; END TABLE STA 1,@TABL,3 JMP CLEA3 ; GO FIND SYS.DR ER2X: ER2 2 ; SEND ERROR JMP ESYS ; EITHER WAY IT IS FATAL JMP FRET .LOOP: LOOP CLIHP: LDA 0,CLIOL ; ADD CLI.- TO TABLE STA 0,@TABL,3 ISZ TABL,3 ISZ TABL,3 JMP CLEA1 ; CONTINUE LOGCM: LOGC*2 CLIOL: CLIO*2 SYSDR: SYSD*2 .CLIDR: CLIDR OLP: OL*2 TUP: TU*2 .SCH: SCH DMASK: 177 MASTR: LDA 0,BUFP,3 ; GET SYSTEM NAME S GSYS JMP ER2X ; SORRY MOVZR 0,2 ; WIPE OUT EXTENοTION IF ANY SUB 1,1 STA 1,SCEXT,2 LDA 1,OLP ; AC1 => .OL LDA 2,SYSP,3 ; WHERE TO BUILD NAME C MKNAM ; MAKE IT SYSTEM.OL STA 2,@TABL,3 ; ADD IT TO TABLE ISZ TABL,3 ISZ TABL,3 LDA 1,TUP ; AC1 => .TU LDA 2,TUNP,3 ; WHERE TO BUILD NAME C MKNAM ; M*AKE IT SYSTEM.TU STA 2,@TABL,3 ; ADD TO TABLE ISZ TABL,3 ISZ TABL,3 JMP CLEA2 ; CONTINUE CLEA3: LDA 0,BUFP,3 ; GET STATS ON SYS.DR MOVZR 0,1 LDA 0,SYSDR S STAT ; GET STATS JMP SYSER ; HOLY COW !! MOV 1,2 ; MAKE IT USABLE LDA 0,UFTDL,2 ; GET SYAS.DR DEVICE CODE LDA 1,DMASK ; EXTRACT JUST DEVICE CODE AND 0,1 STA 1,DEVIC,3 ; SAVE IT FOR LATTER LDA 0,BUFP,3 ; AC0 => BUFFER LDA 1,.SCH ; AC1 = CHANNEL NUMBER C RDSIN ; INIT SYS.DR FOR READING JMP SYSER ; NEVER HAPPEN FIND: LDA 0,BUFP,3 ; GE TABLE C CSNAM ; ONE OF THE NO NO'S *JMP FIND2 ; NO CLEAR IT JMP FIND ; YES FORGET IT FIND2: LDA 0,NAMP,3 C SNTUN ; CONVERT TO USER NAME JMP DOIT ; GO CLEAR IT SYEOF: LDA 1,.EREOF ; WE HAD A SYS.DR ERROR SUB# 1,2,SNR ; END OF FILE ?? JMP ESYS ; YES OK SYSER: LDA 0,SYSDR ; GIVE ERROR ER1 2 JMP ESYS JMP FRET ; GIVE ERROR RETURN .ATLNK: ATLNK .EREOF: EREOF DOIT: S ECLR ; CLEAR THE FILE JMP CLERR ; GIVE ERROR SNZ VERIF ; VERIFY ?? JMP DOIT2 ; NO CONTINUE MOV 0,2 ; YES SAVE FILE NAME LDA 0,VRMES ; AC0 => VERIFY MESSAGE WFRVER VERIF SSAC2 ; WRITE MESSAGE TO PROPER PLACE DOIT2: SKZ ASW ; WHERE TO GO ?? JMP FIND ; OH LOOP: LDA 0,CP,3 ; GET AN ARGUMENT C GETAR JMP ESYS ; ALL DONE LOOP1: STA 0,CP,3 ; SAVE UPDATED POINTER JMP DOIT ; CLEAR IT CLERR: ER1 4 ; GIVE ERROR JMPl DOIT2 ; NORMAL RETURN FRET: LDA 2,SSOSP,3 ; SET ERROR RETURN DSZ SSRTN,2 ESYS: SNZ ASW ; IN SYS.DR ?? JMP CLOS1 ; NO CONTINUE CLOS: S CLOS SCH ; YES CLOSE SYS.DR NOP CLER ASW ; FAKE LOOP ROUTINE TO LDA 0,SYSDR ; CLEAR SYS.DR BY SETTING SYSDR JM]P LOOP1 ; AS CURRENT POINTER CLOS1: LDA 2,VERIF,3 LDA 1,.LCH SUB# 1,2,SZR ; LINE PRINTER VERIFY ?? RTRN ; NO RETURN S CLOS CPU ; YES CLOSE IT NOP RTRN ; THEN RETRN VRMES: VRME*2 ** .NOLOC 1 LOGC: .TXT *LOG.CM* CLIO: .TXT *CLI.-* OL: .TXT *.OL* TU: .TXT *.TU* VRME: .TXT *CLEARED ^C<15>* ** .NOLOC 0 SYSD: .TXT *SYS.DR* ; SYS.DR FAKED TO LOOK LIKE LAST .LCH: LCH ; COM.CM ENTRY (IE TWO WORDS OF "SWITCHES" 377 ; AND A 377 FOLLOWING IT). DUM2.SR5  i ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CDUM2 .RB CDUM2.RB ** .ENDC J .TITL BDUM2 .RB BDUM2.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT ICH= COMCH LCH= CH1 ** .DO CCOND==1 OCH= PUSCH SOCH= COUT ** .ENDC J OCH= TMPCH SOCH= SOUT **[J] .ENTO DUM2E .ENT DUM2 .EXTN CALL RTRN RCALL .EXTN LDBT LDBI .EXTN STBT STBI .EXTN INDEX .INDEX .EXTN SBUFR PCBUF GCBUF BFMVI BFMVO .EXTN GETAR GETSW .EXTN MOVE CMOVE .EXqTN COMP .EXTN WRLCH ** .DO BCOND .EXTN WRLIN ** .ENDC .EXTN .ASCD .EXTN TIMR .EXTN BSPAO BSPAD ; DEFINE THE STACK CP= 1 ; ARG POINTER OP= CP+1 ; OUTPUT FILE NAME POINTER ASW= OP+1 ; ALL SWITCH KSW= ASW+1 ; NO LINK SWITCH SSW= KSW+1 ; SEGMENT SWWITCH VERIF= SSW+1 ; VERIFY FLAG STAIP= VERIF+1 ; INPUT FILE STATS POINTER STAOP= STAIP+1 ; OUTPUT FILE STATS POINTER TMP= STAOP+1 ; TEMPS FOR ALL KINDS OF THINGS TMP1= TMP+1 SEGNO= TMP1+1 ; SEGMENT NUMBER FOR /S ORNAM= SEGNO+1 ; DIRECTORY ARRAY POI NTER RNAMP= ORNAM+10; PLACE TO READ ARGUMENTS LEVEL= RNAMP+1 ; LEVEL INDICATOR NAMEP= LEVEL+1 ; POINTER TO NAME DNAMP= NAMEP+1 ; DIRECTORY NAME POINTER CLENG= DNAMP+1 ; CONTIGUOUS FILE LENGTH BUFP= CLENG+1 ; BUFFER POINTER CNT= BUFP+1 ; COUNT STATIU= CNT+1 ; INPUT FILE WORK AREA STATO= STATI+CFSIZ+SCDBS ; OUTPUT FILE WORK AREA BUFF= STATO+CFSIZ+SCDBS ; DUMP BUFFER NAME= BUFF+200; PLACE TO STORE NAMES STACK= NAME+40 ; STACK SIZE STACK DUM2: ISZ SSRTN,2 ; SET GOOD RETURN C GETSW ; GET SWITCH>ES STA 0,OP,3 ; SAVE POINTER SW A K S ; TEST SWITCHES SETVR VERIF ; TAKE CARE OF VERIFY STUFF LDA 2,STAOD ; SET UP BUFFER POINTERS ADD 3,2 STA 2,STAOP,3 LDA 0,OUTCH ; PUT CHANNEL NUMBER IN BUFFER STA 0,ICHAN,2 LDA 2,STAID ; NOW DO INPUT CHANNEL ADD 3,2 STA 2,STAIP,3 LDA 0,INCH STA 0,ICHAN,2 LDA 0,OP,3 ; GET OUTPUT FILE NAME C GETAR ; GET OUTPUT FILE NAME NOP ; WAS HERE BEFORE - MUST BE HERE NOW STA 0,DNAMP,3 ; SAVE IN CASE OF DUM-DUM STA 0,OP,3 ; AND ALSO FOR ERRORS LDA 1,STAOP,3 ; GET FSTATS S RSTAT JMP @DUER1 MOV 1,2 ; FORCE REGULAR OPEN ADC 1,1 STA 1,UFTYD,2 SUB 1,1 ; NORMAL OPEN C OPEN STATO ; OPEN OUTPUT FILE JMP @DUER1 LDA 2,DUSBP ; SET UP INPUT POINTER LDA 0,BFRPT,2 STA 0,CP,3 PT ORNAM ; SET UP DIR ARRAY POINTER CLER LEVEL ; CLEAR LEVEL INDICATOR BPT NAME NAMEP ; MAKE POINTER TO NAME SPACE ** .DO CCOND ; ONLY FOR CLI LDA 1,VERIF,3 MOVZR# 1,1,SNR ; $LPT OUTPUT ? JMP DUMP1 ; NO CONTINUE LDA 0,NAMEP,3 ; YES PUT OUT HEADER S GDIR ; GET DIRECTORY NAME NOP MOVZWR 0,2 ; WIPE OUT .DR SUB 0,0 STA 0,UFTEX,2 LDA 0,DUMES C WRLCH ; WRITE HEADER NAMEP C TIMR ; PUT OUT TIME ** .ENDC JMP DUMP1 ; CONTINUE DUSBP: SBUFR STAOD: STATO STAID: STATI INCH: ICH OUTCH: OCH DUER1: DERO1 DUDEV: DEVTB ; DEVICE TABLE DUMES: HMESS*2 DUMP1: SNZ SSW ; SEGMENTED TAPE ? JMP DUMP2 ; NO CONTINUE LDA 0,OP,3 ; GET POINTER TO OUTPUT FILE NAME LDA 1,KPER ; SEARCH FOR PERIOD IN IT C INDEX MOV# 0,0,SKP ; IF THERE THEN GO START OUPUT JMP DUMOD ; SEGMENTED TAPE TO DISK ELSE LDA ~2,STAOP,3 ; YES TEST FOR LEGAL FILE LDA 0,UFTEX,2 ; CHECK IF OUTPUTING TO TTP OR MOV# 0,0,SZR ; PTP, IF NOT THEN JMP DUMIL ; ERROR LDA 0,DUDEV STA 0,TMP,3 ; SET TABLE POINTER MOVZL 2,1 DUMDT: LDA 0,@TMP,3 ; GET AN ENTRY ISZ TMP,3 ; BUMP THE TABLE COM# 0,0,SNR ; END OF TABLE ? JMP DUMIL ; YES ILLEGAL FILE NAME C COMP ; MATCH ? JMP DUMOD ; YES OUTPUT DUMMY JMP DUMDT ; NO TRY AGAIN DUMOD: SUBZL 1,1 STA 1,SEGNO,3 ; SET SEGMENT NUMBER JSR @DUOPD ; OUTPUT DUMMY BLOCK JMP @DOFER ; OUTPUTjG ERROR DUMP2: BPT NAME NAMEP ; FORM POINTER TO NAME STA 1,RNAMP,3 ; AND INITIALIZE RNAMP DLOOP: LDA 0,CP,3 ; GET NEXT ARGUMENT LDA 2,DUSBP LDA 1,RNAMP,3 ; PLACE TO READ ARGUMENT C GARBU JMP @DUEND ; THATS IT FOR THIS ONE STA 0,CP,3 ; SAVE THE POINTEcR MOV 1,0 LDA 1,K40 ; LOOK FOR LOCAL /S C .INDEX ; WELL ? JMP DLOP1 ; NO CONTINUE MOV 1,0 ; YES WIPE OUT SPACE SUB 1,1 C STBI DLOP1: STA 0,DNAMP,3 ; SAVE POINTER TO OUTPUT FILE NAME LDA 1,KCOLN C .INDEX ; A DIRECTORY SPECIFIER IN NAME JMP DLOPN2 ; NO CONTINUE INC 1,0 ; YES USE IT FOR INPUT BUT NOT FOR OUTPUT JMP DLOP1 DUMIL: LDA 2,.ERFNM JMP @DUER1 DUEND: DENDD DUIE1: DINDE PERAT: ATPER LINAT: ATLNK DNOPE: ATLNK+ATDIR+ATPAR .ERFNM: ERFNM KCOLN: ": K40: 40 DUOPD: OPDMB DLOP2: LDA 0,NAMEP,3 ; GET STATS ON FILE LDA 1,STAIP,3 MOV 1,2 S STAT JMP @DUIE1 LDA 0,UFTAT,2 ; GET ATTRINUTES SKZ ASW ; ALL ? JMP DLOP3 ; YES ON WITH IT LDA 1,PERAT ; NO TEST FILE FOR PERMANENT AND# 0,1,SZR ; PERMANENT ?? JMP DLOOP ; YES SKIP IT DLOP3: SNZ KSW ; LINKS ALLOWED ? JMP DLOP4 ; YES ON WITH THE SHOW LDA 1,LINAT ; NO TEST FOR THEM AND# 1,0,SZR ; A LINK ? JMP DLOOP ; YES - LINK IT NEVER HAPPENED DLOP4: LDA 1,DNOPE AND# 1,0,SZR ; LINK DIR OR PART ? JMP DHEAD ; YES DON'T TRY TO OPEN uIT LDA 1,READP AND# 1,0,SZR ; READ PROTECTED ? JMP @.RPERR ; YES AN ERROR LDA 0,NAMEP,3 ; OPEN THE FILE SUB 1,1 C OPEN STATI JMP @DUIE1 ; GOOD GRIEF DHEAD: LDA 2,STAIP,3 LDA 1,UFTAT,2 ; GET ATTRIBUTES LDA 0,DCONT AND# 0,1,SNR ; CONT FILE ? JMP PDHEA2 ; NO CONTNUE LDA 1,UFTBK,2 ; YES GET BLOCK COUNT INC 1,1 STA 1,CLENG,3 ; STASH IT LDA 0,DHFM1 ; GET FORMAT LINE MOV 0,0,SKP DHEA2: LDA 0,DHFM2 ; FORMAT LINE FOR NON CONTIG FILES C WRBIN STATO ; WRITE OUT HEADER BLOCK STATI+UFTAT ; ATTRIBUTES 0{CLENG ; LENGTH DNAMP  ; NAME JMP @DOFER ; AN ERROR !!! JMP DLIAT ; NOW LINK ATTRIBUTES DCONT: ATCON .RPERR: RPERR READP: ATRP DSUBR: SUBDR PARDIR: ATPAR+ATDIR DHFM1: DHF1*2 DHFM2: DHF2*2 DLINA: ATLNK DLINP: DLINK OUTC: OCH DLATF: DLAF*2 KPER: ". DTIMF8: DTIF*2 DOFER: OUTFE DLIAT: LDA 1,UFTAT,2 LDA 0,DLINA AND# 1,0,SZR ; A LINK ? JMP @DLINP ; YES GO PROCESS LDA 0,UFTLK,2 MOV 0,0,SNR ; ANY LINK ATTRIBUTES JMP DTIME ; NO DON'T BOTHER OUTPUTING THEM LDA 0,DLATF ; AC0 = FORMAT LINE C WRBIN STATO d; WRITE THEM OUT STATI+UFTLK JMP @DOFER DTIME: LDA 0,DTIMF ; OUTPUT TIME BLOCK C WRBIN STATO STATI+UFTAC STATI+UFTYD STATI+UFTHM JMP @DOFER LDA 1,UFTAT,2 LDA 0,PARDIR AND# 0,1,SZR ; PART OR DIR ?? JMP @DSUBR ; YES GO PROGESS DDATA: BPT BUF@F BUFP ; BUILD POINTER TO BUFFER DDAT1: LDA 0,BUFP,3 LDA 1,KD400 C RDS STATI ; READ 200 WORDS JMP DDARE ; A READ ERROR ! ! ! DDAT2: LDA 3,USP ; RESTORE STACK POINTER STA 1,CNT,3 ; SAVE COUNT MOV# 1,1,SNR ; ZERO BYTES ? JMP DDEOF ; YES END OF FILE MOVZR 1,2,SNR ; ZERO WORDS ?? JMP DDNCK ; YES NO CHECKSUM STA 2,TMP,3 ; SAVE COUNT MOVZR 0,2 ; FORM WORD COUNT DDAT3: LDA 0,0,2 ; FORM CHECKSUM ADD 0,1 INC 2,2 DSZ TMP,3 ; DONE ?? JMP DDAT3 ; NO GET NEXT WORD DDNCK: STA 1,TMP,3 ; STASH CHECKSUM Ӵ LDA 0,DDFLN ; FORMAT LINE C WRBIN STATO ; WRITE DATA BLOCK HEADER CNT TMP JMP @DOFER LDA 1,CNT,3 ; WRITE OUT DATA LDA 0,BUFP,3 C WRS STATO ; WRITE IT OUT JMP @DOFER ; FATAL ERRROR SNZ SSW ; SEGMENT SWITCH ?? JMP DDAT1 ; NO CONTINUE DSZ SSW,3r& ; TIME TO OUTPUT DUMMY ?? JMP DDAT1 ; NO CONTINUE JSR @OPDMP ; OUTPUT DUMMY BLOCK JMP @DOFER ISZ SEGNO,3 ; BUMP SEGMENT NUMBER C CLOSN STATO ; CLOSE OUTPUT CHANNEL JMP @DOFER LDA 0,OP,3 ; GET OTPUT FILE NAME LDA 1,KPER ; CHECK IF OUTPUTING TO THE DISK C INDEX ; IF WE ARE NOT THEN JUST JMP DDN1 ; GO OUTPUT TO DEVICE AGAIN ELSE INC 0,2 ; UPDATE TAPE # IN FILE NAME INC 2,0 C LDBT ; GET LOW ORDER DIGIT INC 1,1 ; INC IT C STBT ; AND STORE IT BACK LDA 0,K9P1 ; IF DID NOT OVERFLOW SUB# 0,1,SMZR ; THEN WE CAN JUST GO OPEN JMP DDN0 ; THE FILE ELSE LDA 1,KZER ; LOW DIGIT GOES TO INC 2,0 ; ZERO C STBT MOV 2,0 ; AND INC THE HIGH DIGIT C LDBT INC 1,1 C STBT DDN0: LDA 0,OP,3 ; GET ADDRESS OF OUTPUT FILE NAME S CRAND ; CREATE THE FILE JMP @nDOFER ; DIE ON ERROR DDN1: SUB 1,1 LDA 0,OP,3 ; REOPEN OUTPUT CHANNEL C OPEN STATO JMP @DOFER JSR @OPDMP ; OUTPUT DUMMY BLOCK JMP @DOFER JMP DDAT1 K9P1: 72 KZER: "0 OPDMP: OPDMB KD400: 400 EOFCD: EREOF DDFLN: DDFL*2 DERFL: DERF*2 OUTC1: OCH INFEP: INFER DDARE: LDA 3,EOFCD SUB# 3,2,SNR ; EOF ?? JMP DDAT2 ; YES PROCESS IT INFER: LDA 3,USP ; RESTORE USP LDA 0,NAMEP,3 ; NO REPORT ERROR ER1 3 NOP LDA 0,DERFL ; PUT OUT ERROR BLOCK SUBZL 1,1 C WRS STATO JMP @DOEF1 C CLOS STATI NOP ; SO WHAT  JMP @.DLOP DDEOF: C CLOS STATI ; CLOSE INPUT CHANNEL JMP INFER DVERY: LDA 1,DVSP ; USE A SPACE AS THE LEADING CHARACTER DVER0: STA 1,TMP1,3 ; SAVE LEADING CHARACTER SNZ VERIF ; VERIFY ?? JMP @.DLOP ; NO CONTINUE LDA 0,VERFM ; FORMAT LINE ADCZL 2,2 ; COUNT = TWO LEVELS LDA 1,LEVEL,3 ; GET LEVEL INDICATOR DVER1: MOVZR 1,1 MOVZR 1,1,SNC ; PUSHED TO THIS LEVEL ? INC 0,0 ; NO TAKE AWAY TWO SPACES INC 2,2,SZR ; TESTEDTWO LEVELS ? JMP DVER1 ; NO TRY NEXT MOVZL 0,0 ; YES MAKE BYTE POINTER TO MESNSAGE WRVER VERIF ; VERIFY FILE DUMPED TMP1 DNAMP JMP @.DLOP ; GO GET NEXT FILE .DLOP: DLOOP .UFLD: UFLAD+STATI .UFLN: UFLAN+STATI DOEF1: OUTFE VERFM: VERF LIN1F: LIN1*2 LIN2F: LIN2*2 DVSP: 40*400+40 DLINK: BPT BUFF BUFP ; FORM POINTER TO BUFFER LDA Y0,.UFLD ; POINT TO ALT DIR NAME ADDZL 3,0 LDA 2,UFLAN+STATI,3 ; ENSURE A TRAILING NULL SUB 1,1 STA 1,UFLAN+STATI,3 C PARIT ; PUT PARITY ON IT STA 0,TMP,3 ; SAVE POINTER TO DATA LDA 0,LIN1F ; PUT IT OUT C WRBIN STATO TMP JMP @DOEF1 ; AN ERRROR S7TA 2,UFLAN+STATI,3 ; RESTORE WORD WE ZEROED LDA 2,.UFLN ; FORM POINTER TO NAME ADD 3,2 LDA 0,BUFP,3 ; PLACE TO MOVE IT C SNTUN ; MAKE IT USER NAME C PARIT ; PARITY IT LDA 0,LIN2F ; PUT IT OUT C WRBIN STATO BUFP JMP @DOEF1 JMP DVERY ; GO VERIFY vIF NECESSARY DEVTB: TTPN*2 TTP1N*2 PTPN*2 PTP1N*2 -1 ** .NOLOC 1 ; SUPPRESS THE CLUTER TTPN: .TXT *$TTP* TTP1N: .TXT *$TTP1* PTPN: .TXT *$PTP* PTP1N: .TXT *$PTP1* DHF1: .TXT /<377>^W^W^C^0/ DHF2: .TXT /<377>^W^I^C^0/ DTIF: .TXT /<373>^W^W^W/ DLAF:O8 .TXT /<371>^W/ DDFL: .TXT /<376>^W^W/ DERF: .TXT /<375>/ DENB: .TXT /<374>/ LIN1: .TXT /<372>^C^0/ LIN2: .TXT /^C^0/ VERF: .TXT / ^W^C<15>/ HMESS: .TXT / ^C^T<70>/ ** .NOLOC 0 0 GARBU: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS C BFMVO ; MOVE ARG TO USER SPACE LDA 2,SSOSP,3 ; RESTORE STACK POINTER STA 0,SSAC0,2 ; RETURN POINTER TO CALLER LDA 0,SSAC1,2 ; GET FIRST BYTE OF ARG C LDBT LDA 0,C200 SUB# 0,1,SZR ; END OF FILE ?? ISZ SSRTN,2 ; NO GIVE NORMAL RETURN RTRN C200: 200 ; END OF FILE INDICATOR ; ERROR HANDLERS ; FILE READ PROTECTED RPERR: LDA 2,ERPR ; AC2 = ERROR CODE ; JMP DINDE ; JOIN COMMON CODE ; INPUT FILE OPENING ERROR DINDE: STA 2,TMP,3 ; SAVE ERROR CODE LDA 1,DINEN SUB# 1,2,SNR ; FILE DOES NOT EXIST ?? JMP DIND2 ; YES DON'T HAVE TO GO ANY FURTHER LDA 2,STAIP,3 ; POINT TO STATS LDA 1,UFTDL,2 ; GET DEVICE CODE LDA 2,DINMK ; MASK TO 7 BITS AND 2,1 LDA 2,DITBL ; POINT TO TABLE OF DISK CODES DIND1: LDA 0,0,2 ; GET A CODE COM# 0,0,SNR ; END OF TABLE ? JMP DIND3 ; YES THIS I6MUST BE A DEVICE - NO ERROR INC 2,2 ; POINT TO NEXT ENTRY SUB# 0,1,SZR ; MATCH ?? JMP DIND1 ; NO CONTINUE DIND2: LDA 2,TMP,3 ; YES - REPORT ERROR LDA 0,NAMEP,3 ER1 4 JMP DIND3 ; CLOSE INPUT AND CONTINUE JMP DFATA ; HE WANTS IT FATAL - WHAT CA[N I DO !!! DIND3: C CLOS STATI ; CLOSE INPUT CHANNEL NOP JMP @DINDL ; GET NEXT FILE DINDL: DLOOP DINMK: 177 ; DEVICE CODE MASK DINEN: ERDLE ERPR: ERRPR DITBL: .+1 DSK DSK1 DKP DKP1 DZP DZP1 DSP DSP1 -1 ; TROUBLE OPENING OUTPUT FILE DERO1: WLDA 3,USP ; RESTORE STACK POINTER LDA 0,OP,3 ; GET FILE NAME ER1 3 ; REPORT ERROR JMP DCLOS ; CLOSE ALL FILES AND RETURN DFATA: LDA 2,SSOSP,3 ; MAKE IT A FATAL ERROR FOR BATCH DSZ SSRTN,2 DCLOS: S CLOS OCH ; CLOSE OUTPUT CHANNEL NOP DCLO1: S CLOS ICHr ; CLOSE INPUT CHANNEL NOP LDA 2,VERIF,3 MOVZR# 2,2,SNR ; LINE PRINTER OPEN ? RTRN ; NO JUST RETURN S CLOS CPU ; YES CLOSE IT NOP RTRN ; ERROR WHILE WRITING OUTPUT FILE OUTFE: LDA 3,USP ; RESTORE STACK POINTER LDA 0,OP,3 ; REPORT ERROR ER1 3  JMP OUTF2 ; CLOSE AND DELETE IT OUTF1: LDA 2,SSOSP,3 ; FATAL IT IS DSZ SSRTN,3 OUTF2: S CLOS OCH ; CLOSE OUTPUT FILE NOP S DELE NOP JMP DCLO1 ; NOW CLOSE THE REST OF THEM ;PARIT ; ROUTINE TO PUT EVEN PARITY ON THE LINE POINTED TO BY AC0 0 PARIT: C LDBT ; GET A BYTE MOV 1,1,SNR ; END ?? RTRN ; YES RETURN C GPAR ; GENERATE PARITY C STBI ; STORE BYTE BACK JMP PARIT ; DO NEXT BYTE 0 GPAR: ADCZ 3,3 ; AC3= -1 , CARRY = 0 GPAR1: MOV 1,0 ADDC 3,0 ; AC0 = N-1 ANDC 0,1,SZR ; N .AND. N-1 ELIM!MINATES A "1" JMP GPAR1 ; NOT DONE IF ANY ONES LEFT SUBC 1,1,SZC ; NEED PARITY ? LDA 1,GP200 ; YES GET IT LDA 0,SSAC1,2 ; GET ORIGIONAL WORD ADD 0,1 ; ADD PARITY STA 1,SSAC1,2 ; RESTORE IT RTRN ; THATS IT GP200: 200 ;OPDMB ; OUTPUT A DUMMY BLOCK OPDMB: INC 3,1 ; SAVE RETURN LDA 3,USP STA 1,TMP,3 ADC 0,0 STA 0,SSW,3 LDA 0,DMBFL ; FORMAT LINE C WRBIN STATO ; WRITE IT OUT SSW ; ATTRIBUTES SEGNO ; SEGMENT # DNAMP ; FILE NAME DSZ TMP,3 ; GOOD GRIEF LDA 1,KBSZ ; RESET COUNT STA 1,-SSW,3 JMP @TMP,3 ; RETURN KBSZ: 106 ; # OF DATA BLOCKS PER SEGMENT DMBFL: .+1*2 ** .NOLOC 1 .TXT /<370>^W^W^C^0/ ** .NOLOC 0 ; PROCESS A SUBDIRECTORY SUBDR: LDA 0,RNAMP,3 ; SAVE CURRENT POINTER STA 0,@ORNAM,3 ISZ ORNAM,3 ; PUSH IT FOR NEXT TIME  LDA 0,LEVEL,3 ; MARK THIS LEVEL MOVOL 0,0 MOVZL 0,0 STA 0,LEVEL,3 LDA 0,NAMEP,3 ; INIT NEW DIRECTORY SUB 1,1 S INIT JMP SUBIE ; AN ERROR MAY BE OK SUBD1: C .INDEX ; FIND END OF THIS MESSS NOP MOV 1,0 LDA 1,SUCOL ; PUT A COLN THERE C STBI STA 0l,RNAMP,3 ; SET UP INPUT POINTER JMP @SUBLP ; BACK FOR NEXT ARG SUBIE: LDA 3,SUEBS SUB# 3,2,SZR ; DEVICE ALREADY IN SYSTEM ? JMP @SUIER ; NO GIVE ERROR LDA 3,USP ; RESTORE USP ISZ LEVEL,3 ; REMEMBER DEVICE IN SYSTEM JMP SUBD1 ; AND CONTINUE SUBFMj: .+1*2 .TXT /<15>/ SUBLP: DLOOP SUCOL: ": SUIER: DERO1 SUEBS: ERIBS ; PROCESS AN END OF DIRECTORY INDICATOR DENDD: STA 0,CP,3 ; SAVE ARG POINTER LDA 0,DENBF ; PUT OUT AN END BLOCK SUBZL 1,1 ; COUNT = 1 C WRS STATO JMP @DENDE LDA 0,LEVEL,3 MOV 0,0,SNR ; PUSHED ?? JMP DECLS ; NO CLOSE UP AND RETURN LDA 0,RNAMP,3 ; FIX UP DIRECTORY NAME NEG 0,0 ; BY WIPEING OUT TRAILING COLON COM 0,0 SUB 1,1 C STBT DSZ ORNAM,3 ; POP IT A LEVEL LDA 0,@ORNAM,3 ; GET ORIGIONAL POINTER BEFORE DIRECTORY STA 0,RNAMP,3 ; SET IT AS CURRENT LDA 1,LEVEL,3 MOVZR 1,1,SZC ; WAS DIRECTORY INITTED ?? JMP DEND1 ; NO CONTINUE S RLSE ; YES RELEASE IT JMP DENFE ; WHAT WE INIT WE MUST RELEASE DEND1: MOVZR 1,1 STA 1,LEVEL,3 ; RESTORE LEVEL FLAG LDA 1,DNAMP,3 ; MOVE DIRECTORY NAME TO WHERE IT CAN BE VERIFIED C MOVE LDA 1,DENST ; USE A STAR FOR THE FIRST CHARACTER OF VERIFY JMP @DEVSP ; GO VERIFY IF NECESSARY DECLS: C CLOS STATO ; CLOSE OUTPUT FILE JMP @DENFR ; WE ALMOST MADE IT JMP @DECL1 ; CLOSE THE REST OF THE FILES AND EXIT DECL1: DCLOS DENFE: ER1 1 ; REPORT ERROR NOP ; THIS ONE IS ALWAYS FATAL JMP @DENFR DENFR: OUTF1 DENST: "**400+40 DEVSP: DVER0 DENLP: DLOOP DENBF: DENB*2 DENDE: DERO1 ; DEFINE THE STACK CHANT= 1 ; CHANNEL TABLE ADDRESS CHAN= CHANT+1 ; PHYSICAL CHANNEL NUMBER TMP= CHAN+1 ; TEMP FOR ALL KINDS OF THINGS TMP0= TMP+1 ; COPY OF CALLERS AC0 TMP1= TMP0+1 ; COPY OF CALLERS AC1 STACK= TMP1 ; STACK LENGTH 0 EFSYS: LDA 3,SSOSP,2 ; PICK UP OLD STACK POINTER LDA 0,@SSRTN,3 ; GET "C@HANNEL NUMBER" ISZ SSRTN,3 ; SET GOOD RETURN ISZ SSRTN,3 LDA 1,SSAC0,3 ; COPY AC0 AND AC1 STA 1,TMP0,2 LDA 1,SSAC1,3 STA 1,TMP1,2 ADDZ 0,3 ; FORM POINTER TO TABLE STA 3,CHANT,2 ; STASH IT LDA 0,ICHAN,3 ; COPY CHANNEL NUMBER STA 0,CHAN,2 STA 3,SSm^AC2,2 ; RETURN TABLE POINTER RTRN STACK RDS: C EFSYS ; DO SETUP RDS1: LDA 2,CHANT,3 ; POINT TO TABLE LDA 0,ICOUN,2 ; GET COUNT REMAINING SUBZ 1,0,SNC ; HAVE ENOUGH FOR THIS REQUEST ? JMP RDSPA ; NO GET SOME MORE STA 1,TMP,3 ; YES SAVE REQUEST1ED COUNT STA 0,ICOUN,2 ; SAVE UPDATED COUNT LDA 0,IPOIN,2 ; FROM POINTER ADD 0,1 ; UPDATE FOR NEXT REQUEST STA 1,IPOIN,2 LDA 2,TMP,3 ; COUNT LDA 1,TMP0,3 ; TO POINTER C CMOVE ; MOVE DATA RTRN ; THATS ALL RDSPA: NEG 0,0 ; AC0 = # WORDS RENAMINIG STA 0,TMP,3 ; SAVE IT LDA 1,TMP0,3 ; UPDATE ADDRESS LDA 0,ICOUN,2 ADD 1,0 STA 0,TMP0,3 LDA 0,IPOIN,2 ; FROM POINTER LDA 2,ICOUN,2 ; COUNT C CMOVE ; MOVE WHAT WE HAVE LDA 2,CHANT,3 ; RESTORE POINTER TO CHANNEL TABLE LDA 2,IREAD,2 ; GET READ ADDRESS RCALL ; CALL IT JMP RDSEOF ; SHOULD BE END OF FILE LDA 1,TMP,3 ; SEE IF ENOUGH JMP RDS1 ; FOR THIS REQUEST RDSEOF: LDA 1,RDSEF SUB# 1,2,SZR ; END OF FILE ?? JMP RDSER ; NO GIVE ERROR LDA 1,TMP1,3 ; RETURN BYTES READ LDA 0,TMP,3 SUB 0,1 LD̷A 3,SSOSP,3 STA 1,SSAC1,3 RDSER: LDA 3,USP ; RESTORE STACK POINTER LDA 3,SSOSP,3 ; OLD STACK POINTER STA 2,SSAC2,3 ; RETURN ERROR CODE DSZ SSRTN,3 ; SET ERROR RETURN RTRN ; THATS IT RDSEF: EREOF STACK WRS: C EFSYS ; DO SETUP STUFF WRS1: LDA 3,CHAENT,3 ; POINT TO CHANNEL TABLE LDA 2,IFLAG,3 ; SET FLAG TO WRITE MOVZL 2,2 MOVOR 2,2 STA 2,IFLAG,3 LDA 2,ICOUN,3 ; GET COUNT LDA 0,ISIZE,3 ; YES GET FULL COUNT SUB 2,0 ; FORM COUNT REMAINING SUBZ 1,0,SNC ; ENOUGH ROOM FOR THIS WRITE ? JMP WRSPA ; TNNO DO PARTIAL ADD 1,2 STA 2,ICOUN,3 ; RESTORE COUNT MOV 1,0 LDA 1,IPOIN,3 ; UPDATE POINTER ADD 1,0 STA 0,IPOIN,3 LDA 3,USP ; RESTORE STACK POINTER LDA 2,TMP1,3 ; COUNT LDA 0,TMP0,3 ; FROM POINTER C CMOVE ; MOVE THE DATA RTRN WRSPA: MOV 3,2 LDYPA 3,USP ; RESTORE STACK POINTER ADD 1,0 STA 0,ICOUN,2 ; SAVE COUNT TO MOVE SUBZ 0,1 ; AC1 = REQUEST OUTSTANDING STA 1,TMP1,3 ; SAVE IT LDA 1,TMP0,3 ; UPDATE INPUT BYTE POINTER ADD 1,0 STA 0,TMP0,3 MOV 1,0 LDA 1,IPOIN,2 LDA 2,ICOUN,2 C CMOVE ; MzOVE WHAT WE HAVE LDA 2,CHANT,3 ; FLUSH OUT BUFFER LDA 1,ISIZE,2 ; FORCE FULL BLOCK WRITE STA 1,ICOUN,2 LDA 2,IWRIT,2 RCALL JMP RDSER ; ERROR RETURN LDA 1,TMP1,3 ; RESTORE COUNT REMAINING JMP WRS1 ; GO TO IT IP= TMP1+1 ; INPUT POINTER OP= IP+1 ,; OUTPUT POINTER TP= OP+1 SP= TP+1 OBBU= SP+1 ; OUTPUT BUFFER PEND= OBBU+100 PEND WRBIN: C EFSYS ; ENTER FILE SYSTEM !!!! STA 0,IP,3 BPT OBBU OP STA 1,SP,3 LOOP: LDA 0,IP,3 ; PICK UP CURRENT POINTER C LDBT ; LOOK AT NEXT BYTE ISZ IP,3 ; BUMP ISNPUT POINTER LDA 2,UPAR ; SEE IF ITS UP ARROW SUB# 2,1,SNR JMP ESC ; YES - ESCAPE LDA 0,OP,3 ; OUTPUT POINTER C STBT ; STORE BYTE ISZ OP,3 ; BUMP OUTPUT POINTER MOV# 1,1,SZR ; LOOK FOR NULL JMP LOOP ; MORE CHARS - GO BACK MOV 0,1 ; AC1 = BP LDڒA 0,SP,3 ; START OF OUTPUT AREA SUB 0,1 ; AC1 = # OF WORDS OUTPUT STA 0,TMP0,3 ; SAVE THEM STA 1,TMP1,3 LDA 0,SP,3 MOV 0,0,SZR ; WHICH WAY DID WE COME IN JMP WRS1 ; WRITE THE MESS OUT LDA 2,SSOSP,3 DSZ SSRTN,2 ; MAKE THE WORLD HAPPY RTRN ; OH THAT WAY OBBU WRIBC: ISZ SSRTN,2 ; MATCH THE WRBIN DISPLACEMENT STA 0,IP,3 ; SAVE INPUT POINTER STA 1,OP,3 ; SAVE OUPUT POINTER CLER SP ; CLEAR FLAG WORD JMP LOOP ; JOIN COMMON CODE UPAR: "^ ESC: LDA 0,IP,3 ; LOOK AT NEXT CHAR C LDBT ISZ IP,3 ; AD)JUST INPUT POINTER LDA 2,TAB ; TABLE POINTER STA 2,TP,3 ; SAVE IN STACK LDA @2,TP,3 ; LOAD A CHAR ISZ TP,3 ; BUMP TABLE POINTER COM# 2,2,SNR ; -1 MEANS END OF TABLE JMP LOOP ; NO MATCH - IGNORE SUB# 2,1,SNR ; LOOK FOR MATCHH JMP .+3 ISZ TP,3 JMP $.-7 LDA 2,SSOSP,3 DSZ SSRTN,2 ; NOTE RETURN IS ONE AHEAD AT THIS TIME LDA @0,SSRTN,2 ISZ SSRTN,2 ISZ SSRTN,2 JMP @TP,3 OCTAL: ADD 0,2 LDA 1,0,2 ; LOAD ARGUMENT LDA 0,OP,3 ; OUTPUT STRING POINTER C BSPAO ; CONVERT TO OCTAL AND STORE JMP DRT ; TAKE SAME ROUTE AS DEC ZER1: SUB 1,1 ZER: LDA 0,OP,3 C STBT ISZ OP,3 DSZ SSRTN,2 JMP LOOP WORD: ADDZL 2,0 LDA 2,C2 JMP MOVCM .LOOP: LOOP DECIM: ADD 0,2 LDA 1,0,2 LDA 0,OP,3 C BSPAD ; CONVERT TO ASCII DECIMAL DRT: JMP @.LOOP CHARS: ADD 0,2 LbDA 0,0,2 LDA 1,OP,3 C MOVE .RT: STA 1,OP,3 JMP @.LOOP CBIN: LDA 1,C377 AND 0,1 ADD 1,2 MOVS 0,1 LDA 0,C377 AND 0,1 LDA 0,0,2 MOV 1,2 MOVCM: LDA 1,OP,3 C CMOVE JMP .RT C377: 377 C2: 2 TAB: .+1 "I JMP .RT+1 "W JMP WORD "O JMP OCTAL "D JMP DECIM "C JMP CHARS 0 JMP ZER "0 JMP ZER1 "F JMP CBIN -1 0 RDSEQ: LDA 2,CHANT,2 ; POINT TO CHANNEL TABLE LDA 0,IBUFP,2 STA 0,IPOIN,2 SUB 1,1 ; WIPE OUT COUNT IN CASE EOF STA 1,ICOUN,2 LDA 1,ISIZE,2 ; # WORDS TO READ LDA 2,ICHAN,2 ; CKHANNEL NUMBER S RDS CPU ; READ THE DATA JMP RDSRR ; SHOULD BE END OF FILE RDSE1: LDA 3,SSOSP,3 LDA 2,CHANT,3 STA 1,ICOUN,2 ; SET COUNT READ ISZ SSRTN,3 RTRN RDSRR: LDA 3,RDEOF ; EOF CODE SNE 3,2 ; WAS ERROR EOF? SNEZ 1 ; YES - WERE ANY BYTES READ? JMP RDRER ; NO - HARD ERROR/EOF + NOTHING READ LDA 3,USP ; OK - RESTORE USP JMP RDSE1 ; CONTINUE 0 WRSEQ: LDA 2,CHANT,2 ; POINT TO TBALE LDA 0,IBUFP,2 STA 0,IPOIN,2 ; RESET POINTER LDA 1,ICOUN,2 ; GET COUNT LDA 2,ICHAN,2 ; AND CHANNEL # S WRS CPU JMP RDRER SUB 1,1 ; RESET COUNT JMP RDSE1 RDRER: LDA 3,USP LDA 3,SSOSP,3 ; SET ERROR RETURN STA 2,SSAC2,3 RTRN ; PROCESS BLOCK READS 0 RDRAN: LDA 3,CHANT,2 ; PICK UP CHANNEL TABLE LDA 1,IBUFP,3 ; RESET INPUT BUFFER POINTER MOVZR 1,0 ; AC.G0 <= WORD ADDRESS STA 1,IPOIN,3 ; RESET POINTER SUB 1,1 ; CLEAR COUNT STA 1,ICOUN,3 LDA 1,IBLOC,3 ; GET BLOCK NUMBER LDA 2,UFTBK,3 ; GET LAST BLOCK NUMBER IN FILE USLE 1,2 ; END OF FILE ? JMP RDREF ; YEP - GIVE IT TO HIM LDA 2,IFLAG,3 ; AC2 <= FLAG WORD MOVR 2,2,SZC ; ATTEMPT PAST BLOCK 177777 ? JMP RDREF ; YES- TREAT LIKE END OF FILE ISZ IBLOC,3 ; NO- BUMP BLOCK NUMBER JMP RDROK ; NO WRAP AROUND- ALL OK MOVOL 2,2 ; PAST BLOCK 177777- STA 2,IFLAG,3 ; SET 1B15 AS FLAG. RDROK: LDA 2,ICHAN,3S ; AC2 <= CHANNEL NUMBER LDA 3,K400 ; AC3 <= 1 BLOCK ADD 3,2 S RDB CPU ; READ THE BLOCK JMP RDRER ; WHATS UP LDA 3,SSOSP,3 ; RETURN THE GOODIES TO CALLER LDA 2,CHANT,3 LDA 0,UFTBK,2 ; GET LAST BLOCK NUMBER SUBZ 1,0,SNR ; THIS IT ?? LDA 1,UFTBC,2 ;Q YEP - COUNT IS IN UFTBC SEQZ 0 ; LAST BLOCK ? LDA 1,ISIZE,2 ; NO SIZE = COUNT READ STA 1,ICOUN,2 ISZ SSRTN,3 ; TAKE GOOD RETURN RTRN RDREF: LDA 2,RDEOF ; GIVE END OF FILE CODE JMP RDRER ; COUNT IS ALREADY ZERO K1000: 1000 K400: 400 K776: 776 mpRDEOF: EREOF 0 WRRAN: LDA 3,CHANT,2 ; PICK UP TABLE POINTER LDA 1,IBUFP,3 MOVZR 1,0 STA 1,IPOIN,3 LDA 1,ICOUN,3 LDA 2,ISIZE,3 SEQ 2,1 ; FULL BLOCK ?? JMP WRRPA ; NO DO PARTIAL NEGOR 1,1 MOV 0,2 ; MAKE BUFFER ADDRESS ACCESSABLE WRRA1: LDA 0,i0,2 ; TEST FOR FULL BLOCK OF ZER0S MOV 0,0,SZR ; WORD ZERO ? JMP WRRWR ; NO WRITE BLOCK OUT INC 2,2 INC 1,1,SZR ; DONE ?? JMP WRRA1 ; NO DO NEXT WORD ISZ IBLOC,3 ; YES ALL ZER0 - BUMP BLOCK NUMBER NOP ; WATCH FOR WRAP AROUND SUB 1,1 ; RESETOi COUNT LDA 3,USP ; EXIT WITHOUT WRITING BLOCK JMP @.RDS1 .RDS1: RDSE1 ; HANDLE BLOCK WRITES - ; BLOCKS CONTAINING ALL ZEROES ARE NOT WRITTEN OUT WRRWR: LDA 0,IPOIN,3 ; WRITE OUT BLOCK MOVZR 0,0 ; ADDRESS LDA 1,IBLOC,3 ; AC1 <= CURRENT BLOCK TO WRITE  INC 1,2 ; AC2 <= NEXT BLOCK NUMBER STA 2,IBLOC,3 ; UPDATE CURRENT BLOCK # STA 2,ICBLK,3 ; AND LAST BLOCK WRITTEN LDA 2,ICHAN,3 ; AC2 <= CHANNEL NUMBER LDA 3,K400 ; FORM CHANNEL NUMBER AND BLOCK COUNT ADD 3,2 S WRB CPU ; WRITE THE BLOCK JMP RDRER ; BAD NEWS SUB 1,1 JMP @.RDS1 ; RETURN WRRPA: LDA 1,IBLOC,3 ; A PARTIAL BLOCK TO WRITE STA 1,ICBLK,3 LDA 2,KM11 ; SHIFT COUNT SUB 0,0 WRPA1: MOVZL 1,1 ; DBL LENGTH SHIFT TO FORM BYTE ADDRESS MOVL 0,0 INC 2,2,SZR JMP WRPA1 LDA 2,ICHAN,3 ; GET CHANN ]EL NUMBER S SPOS CPU ; POSITION FILE TO THIS BLOCK IN CASE OF SKIPED BLOCKS JMP RDRER LDA 3,USP ; WRITE OUT WHAT IS LEFT BY WRS LDA 2,SSOSP,3 JMP @.WRSE .WRSE: WRSEQ KM11: -11 ; OPEN A FILE STACK OPEN: C EFSYS ; DO SETUP MAGIC SUB 1,1 STA 1,IBкLOC,2 ; CLEAR BLOCK NUMBER STA 1,ICBLK,2 ; CLEAR LAST BLOCK WRITTEN STA 1,ICOUN,2 ; CLEAR COUNT STA 1,IFLAG,2 ; CLEAR FLAGS WORD LDA 1,IBUFD ; SET UP BUFFER POINTERS ADDZL 2,1 STA 1,IBUFP,2 STA 1,IPOIN,2 LDA 1,UFTAT,2 ; GET ATTRIBUTES LDA 0,RANCON AND# 0,1,SZR ; RANDOM OR CONTIGUOUS ? JMP OPERN ; YES SET UP FOR BLOCK IO OPENS: LDA 0,RSEQ ; SET UP FOR SEQUENTIAL STA 0,IREAD,2 LDA 0,WSEQ STA 0,IWRIT,2 LDA 0,K776 OPEN1: STA 0,ISIZE,2 LDA 0,TMP0,3 ; DO ACTUAL OPEN LDA 1,UFTYD,2 ; DO WE HAVE A TIME ? COM# 1,1,SZR ; WELL JMP OPENT ; YES DO IT BY MAGIC LDA 1,TMP1,3 LDA 2,CHAN,3 S OPEN CPU JMP OPEER ; HELLO RTRN ; THATS IT OPENT: LDA 1,TMP1,3 LDA 2,CHAN,3 S TOPEN CPU JMP OPEER RTRN IBUFD: IBUFF OPERN: LDA 0,RRAN ; SET UP FOR BLOC[K IO STA 0,IREAD,2 LDA 0,WRAN STA 0,IWRIT,2 LDA 0,K1000 ; SET BLOCK SIZE IN BYTES JMP OPEN1 ; GO DO ACTUAL OPEN RSEQ: RDSEQ WSEQ: WRSEQ RRAN: RDRAN WRAN: WRRAN RANCON: ATRAN+ATCON OPEER: LDA 3,SSOSP,3 DSZ SSRTN,3 STA 2,SSAC2,3 ; TAKE ERROR RETURN { RTRN ; CLOSE FILE ROUTINE STACK CLOSN: C EFSYS ; SAVE THE WORLD SUBC 1,1 ; SET NO ATTRIBUTE FLAG JMP CLOS0 ; JOIN COMMON CODE STACK CLOS: C EFSYS ; DO SETUP ADC 1,1 ; CHANGE ATTRIBUTES FLAG CLOS0: STA 1,TMP0,3 LDA 1,IFLAG,2 ; GET FLAG MOVZL# 1,1,SNC ; WRITING (1B0)? JMP CLOS2 ; NO JUST CLOSE FILE LDA 0,ICOUN,2 ; ANYTHING LEFT IN BUFFER ?? MOV 0,0,SZR ; WELL ?? JMP CLOS3 ; YES FLUSH IT OUT CLOS1: LDA 1,UFTAT,2 LDA 0,RANAT AND# 0,1,SNR ; RANDOM FILE? JMP CLOSC ; NO - JUST CLOSE IT ;UP LDA 1,IBLOC,2 ; LAST BLOCK TO WRITE (+1) LDA 0,ICBLK,2 ; LAST BLOCK WRITTEN (+1) SUB# 0,1,SNR ; LAST BLOCK WRITTEN ? JMP CLOSC ; YES - JUST CLOSE FILE NEG 1,1 ; NO- GET NUMBER OF COM 1,1 ; LAST BLOCK TO WRITE. LDA 3,KM11 ; FORM DOUBLE PRECISION O BYTE SUB 0,0 ; POINTER TO LAST BYTE IN LAST BLOCK. CLOSL: MOVOL 1,1 MOVL 0,0 ; DOUBLE LENGTH SHIFT. INC 3,3,SZR ; DONE ? JMP CLOSL ; NO - KEEP LOOPING LDA 2,ICHAN,2 ; CHANNEL NUMBER S SPOS CPU ; POSITION TO LAST BYTE JMP OPEER LDA 0,BPTNL ; SET ^FILE SIZE BY WRITING A NULL BYTE SUBZL 1,1 ; TO LAST POSITION IN FILE WHICH MUST BE S WRS CPU ; IN A BLOCK CONTAINING ALL ZEROES. JMP OPEER CLOSC: SNZ TMP0 ; CHANGE ATTRIBUTES ? JMP CLOS2 ; NO CONTINUE LDA 2,CHANT,3 ; CHANGE THE ATTRIBUTES LDA 0,UFT~AT,2 LDA 2,CHAN,3 S CHATR CPU JMP OPEER LDA 2,CHANT,3 ; CHANGE THE LINK ATTRIBUTES LDA 0,UFTLK,2 LDA 2,CHAN,3 S CHLAT CPU JMP OPEER CLOS2: LDA 2,CHAN,3 ; CHANNEL NUMBER S CLOS CPU ; CLOSE FILE JMP OPEER RTRN ; AND RETURN. RANAT: ATRAN CLO7S3: LDA 2,IWRIT,2 ; WRITE OUT LAST BLOCK RCALL JMP OPEER LDA 2,CHANT,3 JMP CLOS1 ; CONTINUE CLOSE BPTNL: .+1*2 0 ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FaRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX C WRIBC SSAC2 EXTX MOVZf,R 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX: .+1*2 .TXT /^C.^W^0/ OVREV.SR5 V ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL COVREV .RB COVREV.RB ** .ENDC J .TITL BOVREV .RB BOVREV.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT REVV REVV: . ; REV CONTAINS LOCATION OF REVV MESSAGE.SR5 1; ; MESSAGE- ; WRITE TEXT TO CONSOLE OUTPUT DEVICE ; ON CHANNEL 1. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMESSAGE .RB CMESSAGE.RB ** .ENDC J .TITL BMESSAGE .RB BMESSAGE*u.RB **[J] .NREL .TXTM 1 ; PACK 'EM LEFT TO RIGHT .ENT MESSAGE ; ENTRY POINT .EXTN GETARG ; GET NEXT ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN WRLIN ; WRITE LINE TO CONSOLE .EXTN CALL RTRN ; LINKAGE ROUTINES 0 MESSAG: ISZ SSRTN,2 ; SET GOOD RE)TURN MESGL: C GETARG ; GET MESSAGE POINTER TO AC0 JMP MESGP ; NO MORE ARGS- GO CHECK FOR PAUSE S WRL COUT ; WRITE OUT MESSAGE JMP MSGER ; ERROR ON WRITE LOG ; SEND TO LOG FILE IF NECESSARY MOV 0,2 ; SAVE ARG POINTER IN AC2 LDA 0,SMESG ; POINT AC0 TO SPACE TEXT C WRLIN ; PUMP OUT A SPACE BETWEEN ARGUMENTS MOV 2,0 ; RESTORE ARGUMENT POINTER JMP MESGL ; GET NEXT ARGUMENT ; TAKE CARE OF PAUSE OPTION MESGP: LDA 0,CMESG ; PICK UP POINTER TO C/R TEXT C WRLIN ; OUTPUT C/R FOR NEATNESS LDA 2,SSOSP,3 ; RESTORE OLD STACK POINTER LDA 0,SSAC0,2 ; PICK UP POINTER TO COMMAND C GETSW ; GET SWITCHES LDA 0,PSW ; SEE IF PAUSE SWITCH SET AND# 0,1,SNR ; IS "P" SWITCH SET? RTRN ; NO- LEAVE IT AT THAT LDA 0,PMESG ; YES- OUTPUT PAUSE MESSAGE C WRLIN ; TO THE CONSOLE. S GCHAR ; GIVE USER THE PAUSE THAT REFRESHES NOP RTRN ; USER IS READY- THAT'S ALL!! ; ERROR ON WRITE TO CONSOLE MSGER: ER2 ; REPORT ERROR RTRN ; AND QUIT PSW: P.SW ** .NOLOC 1 CMESG: .+1*2 .TXT *<15>* SMESG: .+1*2 .TXT * * PMESG;: .+1*2 .TXT *STRIKE ANY KEY TO CONTINUE<15>* ** .NOLOC 0 EXEC.SR5 ; ; ; PROGRAM TO INTERPRET COMMAND LINE AND ; PRODUCE A FORMATTED COMMAND FILE ,(F)COM.CM, ; FOR SYSTEM UTILITIES THAT ARE TREATED SPECIALLY BY ; THE CLI/BATCH MONITOR. ; ; ALSO CALLS THESE UTILITIES INTO EXECUTION. ; ; AC0 -> COMMAND LINE ; AC1 CONTAINS bCOMMAND CODE (ARG. TO .EXEC) ; C EXEC ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CEXEC .RB CEXEC.RB ** .ENDC J .TITL BEXEC .RB BEXEC.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT EXEC .EXTN MKNAM,MKFLA .EXTN CALL,RTRN,GETARG .EXTN MKFIL,VRFIL,COMP,RCALL,GETSW,SETSW .EXTN GETSP,WRBIN,INDEX,.ASCB,LDBT,STBT .EXTN MOVE ; CHARACTER MOVER ** .DO CCOND .EXTN EXER ; EXECUTE ERROR RETURN .EXTN SPYF ; LOG FILE FLAG .EXTN LOGER ; LOG FILE ERROR ROUTINE ** .ENDC T .EXTN BUF2P ** [T] ; DEFINITIONS. OCH= COMCH ; OUTPUT CHANNEL CP= 1 ; -> COMMAND LINE CMCD= 2 ; COMMAND CODE CFP= 3 ; CMD FILENAME PTR TABP= 4 ; ADDRESS OF COMMAND TABLE PARGP= 5 ; -> PRIMARY ARGUMENT ERSW= 6 BUFFP= 7 ; -> BUFF XSWP= 10 ; SWITCHES PTR NAMP= 11 TTABP= 12 MODE= 13 TMP= 14 ; TEMPORARY FARGP= 15 ; FIRST ARG POINTER BUFF= 16 ; NAME BUFFER STSIZ= BUFF+SCLLG ; ; INITIALIZATION. ; STSIZ ; STACK FRAME SIZE EXEC: STA 0,CP,3 ;h SAVE COMMAND POINTER STA 1,CMCD,3 ; SAVE COMMAND CODE LDA 0,FCMFP ; PTR TO FCOM.CM LDA 2,USTP LDA 2,USTPC,2 ** .DO BCOND MOV# 2,2,SNR ** .ENDC T MOV# 2,2,SZR JMP .+5 ; IN FG LDA 2,FGCB ; FG CODE COM# 1,1,SZR ; CMD CODE -1? AND# 1,2,SNR ; NO - C?OULD BE FG JMP .+3 ; BACKGROUND LDA 2,.TTO1P ; FG - CONSOLE DEVICE IS $TTO1 JMP .+3 LDA 2,.TTOP ; CONSOLE DEVICE IS $TTO ** [T] INC 0,0 ; BG - PTR TO COM.CM INSTEAD STA 0,CFP,3 ; REMEMBER WHICH CMD FILENAME ** .DO CCOND STA 2,@.CONSP ; SET CONSOLE DEVICE PTR ** .ENDC S DELET ; DELETE OLD ONE NOP ; IGNORE ERROR S CREAT ; CREATE NEW ONE JMP @FILR ; FATAL ERROR S OPEN OCH ; OPEN FOR WRITING JMP @FILR SUB 0,0 ; INITIALIZE STACK STUFF STA 0,ERSW,3 STA 0,MODE,3 LDA 0,BUFFD ADDZL 3,0 ; BYTE PTR STA 0,BUFFP,3 ; ; LOCATE COMMAND TABLE IN MASTER TABLE ; LDA 0,CP,3 ; COMMAND LINE PTR C GETARG ; GET POINTER TO FIRST ARG ADC 0,0 ; NO ARGS = -1 STA 0,FARGP,3 ; => TO FIRST ARG LDA 0,CP,3 ; => TO COMMAND LINE LDA 2,TABAD ; MASTER TABLE ADDRESS FLOOP: LDA 1,0,2 ; PTR TO COMMAND NAME COM# 1,1,SNR ; -1 MEANS END OF TABLE JMP @NC ; ERROR - NOT A COMMAND INC 2,2 ; INC. ADDRESS C COMP ; COMPARE NAMES JMP FOUND ; A MATCH INC 2,2 ; POINTS TO NEXT NAME PTR JMP FLOOP ; KEEP SEARCHING FOU)ND: LDA 2,0,2 ; ADDRESS OF COMMAND TABLE STA 2,TABP,3 ; SAVE FOR LATER ; ; LOCATE PRIMARY ARGUMENT ; XLOOP: LDA 2,TABP,3 ; TABLE ADDRESS INC 2,2 ; SKIP GLOBAL ACTION TABLE LDA 1,-1,2 COM# 1,1,SZR JMP .-3 C GETARG ; GET PTR TO NEXT ARGUMENT JMP DPFA ; NO SOURCE - CHECK DEFAULT INC 2,2 XLP1: LDA 1,0,2 ; TEST ADDRESS INC 2,2 COM# 1,1,SNR ; -1 MEANS END OF ARG LIST JMP CKEX1 ; USE PRESENT ARG C TSTSW ; TEST SWITCHES JMP XLP1 ; NO MATCH - TEST NEXT SET JMP XLOOP ; A MATCH - TRY ANOTHER CKEX1: LDA 2,0,2 ; SOURCE ARG TBLE POINTER CKEX: LDA 1,0,2 ; CHECK EXCEPTIO LIST NOW COM# 1,1,SNR JMP PARF ; END OF LIST MOV 2,1 C TSTSW ; COMPARE SWITCHES JMP .+2 ; NO MATCH JMP XLOOP ; A MATCH - BAG THIS ARG. INC 2,2 INC 2,2 INC 2,2 ; NEXT ENTRY JMe

NULL STRING STA 0,XSWP,3 ; POINT TO SWITCHES LDA 0,0,2 ; NAME OPTION MOV# 0,0,SZR ; ZERO MEANS ARGS NAME JMP .+5 ; NOT ZERO LDA 0,NAMP,3 ; THIS NAME - USE ITS SWS C GETSP ; PTR TO SWS STA 1,XSWP,3 ; SAVE FOR WRITING SUBZL 1,1 ; TEST FOR ONE SUB# 0,1,SNR ; MEANS PRIMARY ARGS NAME LDA 0,PARGP,3 ; USE IT MOVL# 0,0,SNC ; 1B0 SET? JMP GOT ; NO MOV 2,1 ; HANG ONTO AC2 COM# 0,0,SZR ; WAS IT -1? INC 0,2,SKP ; INDIRECT - USE AS ADDRESS LDA) 2,TABP,3 ; DEFAULT IS PRIMARY ARG LDA 0,-1,2 ; NOW FIND IT MOV 1,2 ; RESTORE TABLE PTR GOT: STA 0,TMP,3 ; SAVE IN TMP ; ; COMPUTE EXTENSION OPTION ; LDA 0,1,2 ; OPTION IDENTIFIER MOV# 0,0,SNR ; ZERO MEANS THIS ARGS EXT JMP TEXT ; GO USE IT SUBZL 1,1 ; ONE MEANS USR PRIMARY ARGS EXT SUB# 0,1,SNR JMP PEXT ; GO FIND DCOM: MOV 0,2 LDA 0,TMP,3 C LDBT STA 1,BUFF,3 MOV# 1,1,SNR JMP BVER LDA 1,MODE,3 ; MODE WORD ADDL# 1,1,SNC ; 1B1= DON'T APPEND , CREATE IF NOT THERE JMP SKVER LDA 3,C4 SUB# 3I,1,SNR JMP DCOM1 LDA 3,USP ; RESTORE STACK POINTER ADDZL# 1,1,SZR JMP MKNM ; JUST MAKE IT DONT CREATE MOV 2,1 LDA 2,BUFFP,3 C MKFIL ; RECREATE AND WRITE-VERIFY JMP @MKAD JMP BVER DCOM1: MOV 2,1 LDA 3,USP ; RESTORE STACK POINTER LDA 2,BUFFP,3 ; POINT TO NAME SPACE C VRFIL ; VERIFY ITS EXISTANCE JMP @MKAD JMP BVER ; END OF CROCK MKNM: MOV 2,1 LDA 2,BUFFP,3 C MKNAM JMP BVER SKVER: MOV 2,1 LDA 2,BUFFP,3 C MKFLA ; MAKE FOR APPENDING AND WRITE-VERIFY JMP @MKAD BVER: LDA 0,LINE ; WRITE1 THIS NAME AND SWITCHES LDA 1,OCHD C WRBIN BUFFP 4*400+XSWP JMP @WRED SUB 0,0 ; ZERO OUT MODE WORD STA 0,MODE,3 ; FOR EACH ARGUMENT JMP LOOP GLOBAL: LDA 2,C4 ADD 2,1 LDA 0,CP,3 C TSTSW JMP .+2 JMP SWMAT-2 ADD 1,2 JMP SWMAT PEXT: LDA 0,PARsVGP,3 JMP .+2 TEXT: LDA 0,NAMP,3 LDA 1,PERD C INDEX NOP JMP DCOM WRED: WRERR C4: 4 ZERP: ZP*2 MKAD: MKER PERD: ". ; ; PROCESS SOURCE ARGUMENTS ; DONE: LDA 0,PARGP,3 ; PRIM ARG PTR COM# 0,0,SNR JMP DFARG ; WASNT ANY LDA 0,FARGP,3 ; FIRST ARG NEWi ARG: LDA 2,TABP,3 ; TABLE PTR AGAIN SWFAIL: LDA 1,0,2 ; LOOK FOR END OF TABLE INC 2,2 COM# 1,1,SNR ; -1 IS END OF TABLE JMP FILOK ; NO LOCALS LEFT - ARG IS OK C TSTSW ; COMPARE SWITCHES JMP SWFAIL ; OK SO FAR LOOP.: C GETARG ; ARG NO GOOD - GET NEXT  JMP ALLDON ; ALL DONE STA 0,FARGP,3 JMP NEWARG ; DO THIS ONE FILOK: LDA 2,0,2 C GETSP STA 1,XSWP,3 FILLP: LDA 1,0,2 ; LOOK FOR ARG EXCEPTION COM# 1,1,SNR ; -1 MEANS END OF EXCEPTION LIST JMP RFIL ; GOOD - ORDINARY ARGUMENT MOV 2,1 INC 2,2 INC 2,62 INC 2,2 C TSTSW ; EXCEPTION LIST - CHECK SWS JMP FILLP ; NO MATCH - CHECK NEXT MOV 2,1 ; SAVE AC2 LDA 2,-1,2 ; EXCEPTION - CALL ITS CODE RCALL JMP LOOP. ; GET NEXT ARG MOV 1,2 JMP FILLP ; IGNORE ARG RETURN RFIL: LDA 1,1,2 ; EXTENSION NAME LDA 2,BUFFP,3 COM# 1,1,SNR ; -1 MEANS DONT VERIFY JMP NOVX C VRFIL ; VERIFY ITS EXISTANCE JMP MKER ; SOME ERROR - GO REPORT NOVER: LDA 0,LINE LDA 1,OCHD C WRBIN BUFFP 4*400+XSWP JMP WRERR NXAR: LDA 0,FARGP,3 JMP LOOP. DFARG: LDA 2,TABP,3 LDA 0,#-1,2 ; DEFAULT SOURCE NAME LDA 2,@TTABP,3 ; EXCEPTIONAL ARG LIST JMP .+2 INC 2,2 LDA 1,0,2 COM# 1,1,SZR ; FIND END OF TABLE JMP .-3 LDA 1,ZERP STA 1,XSWP,3 ; CLEAR SWITCHES LDA 1,CP,3 STA 1,FARGP,3 JMP RFIL NOVX: MOV 2,1 C MOVE JMP NOVER MKE R: LDA 0,BUFFP,3 VRER: ER1 2 ; REPORT ERROR NOP STA 0,ERSW,3 JMP NXAR OCHD: OCH LINE: OLIN*2 ; ; CALL COMMAND (.EXEC IT!) ; ALLDON: S CLOS OCH ; CLOSE COMMAND FILE JMP WRERR ; BAD ERROR LDA 0,ERSW,3 ; ABORT CODE MOV# 0,0,SZR JMP ERET LDA 0,CP@,3 ; COMMAND NAME LDA 1,SAVP ; -> .SV LDA 2,BUFFP,3 ; BUFFER POINTER C MKNAM MOV 2,0 LDA 1,CMCD,3 ; CODE COM 1,1,SZR ; RESET -1 CODE COM 1,1 ; NOT -1, PUT IT BACK ** .DO CCOND LDA 3,@LOGF ; AC3 <= LOG FILE FLAG LDA 2,TSW ; AC2 <= LOG FILE TRACE B'IT AND# 2,3,SNR ; IF NOT TRACING JMP NOLOG ; THEN DON'T WORRY ABOUT LOG FILE S UPDAT KCH ; ELSE INSURE LOG FILE INTEGRITY. JMP @.LOGER ; FATAL ERROR !!! NOLOG: SUB 2,2 ; CLEAR AC2 FOR CALLED PROGRAM LDA 3,FGCD ; FG BIT SET? AND# 1,3,SZR JMP FGEX ** .ENDC J S CLOS SOUT ; CLOSE SYSOUT NOP SUB 2,2 ; CLEAR AC2 FOR CALLED PROGRAM **[J] S EXEC ; CALL IT ** .DO BCOND JMP FILER LDA 0,.SYSP LDA 1,.DCFO S APPEN SOUT NOP LDA 2,SSOSP,3 ISZ SSRTN,2 RET: LDA 0,TWIRP S OPEN OCH JMP OUT LDA 0,.BUF2 LUP: S RDL OCH JMP OUT S WRL SOUT JMP OUT JMP LUP .SYSP: SYSP*2 .DCFO: DCFFO TWIRP: TWERP*2 OUT: S CLOS OCH NOP LDA 0,TWIRP S DELE NOP RTRN .BUF2: BUF2P ** .ENDC T JMP .EXER RET: RTRN FGEX: S EXFG JMP .EXER RTRN TSW: T.SW LOGF: SPYF .LOGTER: LOGER **[T] WRERR: LDA 0,CFP,3 FILER: ER1 2 ; REPORT ERROR JMP NFER ERET: S CLOS OCH NOP JMP RET NOCOM: LDA 2,NCER ER2 2 ; REPORT ERROR JMP NFER JMP ERET NSERR: LDA 2,NSERM JMP NOCOM+1 NFER: LDA 2,SSOSP,3 ISZ SSRTN,2 JMP ERET WRAD: WRERR PER: ". NCER: CNACM SAVP: SVP*2 NSERM: CNSFS FGCD: 1B7 DWRER: LDA 2,SSOSP,3 LDA 0,WRAD STA 0,SSRTN,2 RTRN ** .DO CCOND .EXER: LDA 3,SSOSP,3 ; AN ERROR POP TO EXER STA 2,SSAC2,3 ; RETURN ERROR CODE LDA 1,EXERP STA 1,SSRTN,3 RTRN EXERP: EXER ** .ENDC ; ; ROUTINE TO TEST SWITCHES ; AC0 -> SOURCE ARG (BYTE PTR) ; AC1 CONTAINS ADDRESS OF SWITCH MASK (2 WORDS) ; ; C TSTSW ; -NOT ALL INDICATED SWITCHES ARE SET ; -ALL INDICATED SWITCHES ARE SET ; XTMP=1 ; TEMP XTMP TSTSW: STA 1,XTMP,3 ; SAVE MASK ADDRESS MOV 1,2 ; ZERO MASK MATCHES ANYTHING LDA 1,0,2 LDA 2,1,2 ADDZ# 2,1,SNR JMP RTEN C GETSW ; GET OUT SWITCHES LDA 3,XTMP,3 ; ADDRESS LDA 0,0,3 ; FIRST BANK AND 0,1 SZR JMP RTEN ; FIRST WORD DOES LDA 0,1,3 ; SECOND BANK AND 0,2,SNR ; DOeES SECOND WORD? RTRN RTEN: LDA 3,USP LDA 2,SSOSP,3 ISZ SSRTN,2 RTRN ; ; DRIVER TABLES ; ; MASTER COMMAND NAME TABLE TAB: ASMP*2 ; -> "ASM" ASMTP ; COMMAND TABLE FOR ASM MACP*2 ; -> "MAC" MACTP ; COMMAND TABLE FOR MAC MASMP*2 ; -> "MASM" MdASTP RLDP*2 ; -> "RLDR" RLDTP OVLP*2 ; -> "OVLDR" OVLTP ALGP*2 ; -> "ALGOL" ALGTP FORP*2 ; -> "FORT" FORTP FRTRP*2 ; -> "FORTRAN" FORTP LFEP*2 ; -> "LFE" LFETP ** .DO CCOND CLGP*2 ; -> "CLG" CLGTP BATP*2 ; -> "BATCH" BATTP ** .ENDC m -1 ; END OF NAME TABLE ; ; MAIN COMMAND DRIVER TABLES ; ASMTP: -1 ; GLOBAL ACTION ** .DO CCOND -1 ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG ; ERROR FILE OPTION AARG1 ; ARG #1 AARG2 ; ARG #2 -1 AARG ; FOR OTHER ARGS MACTP: -1 ; GLOBeAL ACTION ** .DO CCOND -1 ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG ; ERROR FILE MCAG1 ; ARGU FOR .RB FILE AARG2 ; ARGU FOR LISTING FILE STMAC ; ARGU FOR SYM-TABLE FILE -1 ; END OF DEFAULT ARGUS AARG ; FOR ALL OTHER SOURCE ARGU'S MASTP: -1 ; GLOBAL ACTION ** .DO CCOND -1 ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG ; ERROR FILE MSAG1 ; ARGU FOR .OB FILE AARG2 ; ARGU FOR LISTING FILE STMAS ; ARGU FOR SYM-TABLE FILE -1 ; END OF DEFAULT ARGUS AARG ; FOR ALL OTHER SOURCEb ARGU'S RLDTP: -1 ; GLOBAL ACTION ** .DO CCOND -1 ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG RARG1 RARG2 -1 RARG OVLTP: 0 ; FAKE OUT THE SWITCH TESTER 0 SVSW ; SET INVISIBLE SWITCH -1 ; END OF GLOBAL ACTION -1 ; SOURCE DEFAULT ERANRG ; ERROR FILE RARG1 ; LISTING FILE OARG1 ; OUTPUT OARG2 ; SAVE FILE -1 OARG ALGTP: A.SW ; /A SWITCH 0 SETBS ; SET /B/N SWITCHES -1 ; END OF GLOBAL ACTION ** .DO CCOND -1 ; SOURCE DEFAULT ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERAR&G AARG1 ; BINARY AARG2 ; LISTING @LARG3 ; SOURCE -1 LARG ; ALGOL FORTP: A.SW ; /A 0 SETBS ; SET /B/N SWITCHES -1 ; END OF GLOBAL ACTION ** .DO CCOND -1 ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG AARG1 ; BINARY AARG2 ; LISTING y@LARG3 ; SOURCE -1 FARG ; FORTRAN LFETP: -1 ; GLOBAL ACTION ** .DO CCOND -1 ; SOURCE DEFAULT ** .ENDC T TMPP*2 ; SOURCE DEFAULT ** [T] ERARG LARG1 ; OUTPUT FILE LARG2 ; LISTING -1 EARG ; SOURCE ARGS. ** .DO CCOND BATTP: -1 CDRP*2 ; CDR SOURCE DEFAULT BARG1 ; LOG FILE BARG2 ; SYSOUT FILE -1 BARG ** .ENDC 0 ERARG: E.SW ; /E LOCAL 0 0 ; THIS NAME 0 E.SW ; /E GLOBAL 0 ** .DO CCOND @CONSP ; CONSOLE DEVICE PTR ZP*2 @CONSP ; DEFAULT TO CONSOLE DEVICE ZP*2 ** .ENDC T TMPfP*2 ERP*2 TMPP*2 ERP*2 ** [T] EARG: -1 -1 1B1 ; DONT APPEND THIS OUTPUT DEVICE LARG1: O.SW ; /O LOCAL 0 0 ; THIS NAME 0 ; THIS EXT 0 1B10 ; IMPOSSIBLE -1 ; DONT CARE GLOBALS -1 1 ; PRIM NAME ALBP*2 ; ALTERNATE EXT 0 LARG2: L.SW ; d/L LOCAL 0 0 ; THIS NAME AND EXT 0 L.SW ; /L GLOBAL 0 ** .DO CCOND LPTP*2 ; DOES TO LINE PROINTER 0 LPTP*2 ; $LPT DDFAULT ** .ENDC T SYSP*2 0 SYSP*2 ** [T] ZP*2 ** .DO CCOND 0 BARG1: G.SW ; /G LOG FILE 0 0 ; THIS NAME 0 ; THIS EXT 0 1B11 ; NO GLOBAL -1 -1 @CONSP ; DEFAULT TO CONSOLE DEVICE ZP*2 0 BARG2: O.SW ; /O SYSOUT 0 0 ; THIS NAME 0 ; THIS EXT 0 1B11 ; NO SUCH GLOBAL -1 -1  LPTP*2 ; DEFAULT TO LPT ZP*2 BARG: -1 JBP*2 ; -> .JB ** .ENDC ; ARG TABLES FORK{ ASSEMBLERS 1B1 ; DONT APPEND THIS ONE AARG1: B.SW ; /B 0 ; LOCAL 0 ; THIS NAME 0 ; THIS EXT N.SW ; /N 0 ; GLOBAL ZP*2 ; NULL NAME ZP*2 ; NULL EXT 1 ; DEFAULTS - PRIMARY NAME RBP*2 ; -> .RB (EXT) 0 AARG2: L.SW ; /L 0 ; LOCAL 0 F-; THIS NAME 0 ; THIS EXT L.SW ; /L 0 ; GLOBAL ** .DO CCOND 1 ; PRIMARY NAME LSP*2 ; -> .LS ** .ENDC T SYSP*2 ZP*2 ** [T] ZP*2 ; DEFAULTS - NULL NAME ZP*2 ; NULL EXT 1B1+1B14 ; MKNAM ONLY DONT DELETE/CREATE IT MCAG1: B.SW ; /B LOCAL SW 0 0 ; THIS NAME 0 ; THIS EXTEN N.SW ; GLOBAL /N 0 ZP*2 ; NULL NAME ZP*2 ; NULL EXTN 1 ; FOR DEFAULT USE PRIMARY ARGU RBP*2 ; AND APPEND .RB EXTENTION 1B1+1B14 ; MKNAM ONLY DON'T DELETE/CREATE IT MSAG1: B.SW ; /B LOCAL SWITCH 0 0 ; THIS NAME 0 ; THIS EXTEN N.SW ; GLOBAL /N 0 ZP*2 ; NULL NAME ZP*2 ; NULL EXTEN 1 ; FOR DEFAULT USE PRIMARY ARGU OBP*2 ; AND ADD .OB EXTENSION ; DEFAULT SYM-TABLE FILE FOR MAC 1B1+1B14 ; MKNAM ONLY DON'T DELETE/CREATE STMAC: 0 ; /T T.SW ; LOCAL SWITCH 0 ; THIS NAME 0 ; THIS EXTENSION 0 1B11 ; IMPOSSIBLE GLOBAL -1 ; DON'T CARE -1 MACP*2 ; "MAC" PST*2 ; ".PS" ; DEFAULT SYMBOL TABLE FOR MASM 1B1+1B14 ; MKNAM ONLY DON'T DELETE/CREATE STMAS: 0 ; /T T.SW ; LOCAL SWITCH 0 ; TH>IS NAME 0 ; THIS EXTENSION 0 1B11 ; IMPOSSIBLE GLOBAL -1 ; DON'T CARE -1 MASMP*2 ; "MASM" PST*2 ; ".PS" ; ARG TABLES FOR LOADERS 0 RARG1: L.SW ; /L - LIST FILE NAME 0 ; LOCAL 0 ; THIS NAME 0 ; THIS EXT 0 ; IMPOSSIBLE 1B10 ; GLOBAL -1 ; DONT -1 ; CARE ZP*2 ZP*2 ; NULL EXT 1B1 ; DONT APPEND RARG2: 0 ; /S - SAVE FILE NAME S.SW ; LOCAL 0 ; THIS NAME SVP*2 ; .SV EXT 0 ; IMPOSSIBLE 1B10 ; GLOBAL SW -1 ; DONT -1 ; CARE 1 ; DEFAULTS - PRIMARY NAME SVP*2 ; .SV ExXT 1B1 OARG1: 0 1B11 ; INVISIBLE LOCAL SWITCH 1 ; PRIMARY ARG NAME ORP*2 ; -> .OR 0 1B11 ; IMPOSSIBLE GLOBAL -1 -1 ZP*2 ZP*2 4 OARG2: 0 1B11 ; INVISIBLE LOCAL 1 ; PRIMARY NAME SVP*2 ; .SV 0 1B11 -1 -1 ZP*2 ZP*2 AARG: 0 ; /S 'LOCAL S.SW IGN ; JUST IGNORE AT1: -1 ; NO LOCALS SRP*2 ; -> .SR RARG: N.SW ; /N - NMAX 0 NUMBR ; EXCEPTION CODE C.SW ; /C - CHANNEL 0 NUMBR F.SW ; /F - FOREGROUND ADDR 0 NUMBR K.SW ; /K - TASK 0 NUMBR 0 ; /W GEORGE W.SW NUMBR 0 j Z.SW ; /Z - FOREGROUND ZREL ADDR NUMBR 0 1B10 ; BRACKET, COMMA BRKT ST1: -1 RBP*2 ; -> .RB OARG: N.SW ; /N NODE SYMBOL 0 OVPAS -1 ; END OF EXCEPTION LIST RBP*2 ; -> .RB ; ; EXCEPTION CODE ; YTMP= 1 YSWP= 2 YSWP NUMBR: C .ASCB JMP A`SBER STA 1,YTMP,3 LDA 2,XSWP,2 STA 2,YSWP,3 LDA 0,NLIN LDA 1,OCHDX C WRBIN YTMP 4*400+YSWP JMP @DWRD RTRN DWRD: DWRER OCHDX: OCH ZSWP: ZP*2 LINP: OLIN*2 NLIN: .+1*2 ** .NOLOC 1 .TXT /<33>^0^W^F/ ** .NOLOC 0 BTMP=1 BSWP=BTMP+1 BSWP BRKT: LDhA 1,FARGP,2 STA 1,BTMP,3 LDA 2,XSWP,2 ANYRG: STA 2,BSWP,3 LDA 0,LINP LDA 1,OCHDX C WRBIN BTMP 4*400+BSWP JMP @DWRD RTRN BSWP OVPAS: STA 0,BTMP,3 ; STAVE ARG PTR LDA 2,XSWP,2 ; PASS ARGUMENT AND SWITCHES INTACT JMP ANYRG 0 IGN: ISZ SSRTN,2 RVTRN ASBER: LDA 3,SSOSP,3 ; SET ERSW TO SHOW ERROR STA 2,ERSW,3 ER1 4 ; REPORT ERROR NOP RTRN ; CONTINUE SCAN 1B1 ; DON'T APPEND LARG3: 0 ; /S S.SW ; LOCAL 0 ; THIS NAME 0 ; THIS EXT. 0 1B10 ; IMPOSSIBLE GLOBAL -1 ; DON'T CARE -1 ; D2ON'T CARE 1 SRP*2 ; -> ".SR" LARG: -1 ALP*2 ; -> ".AL" FARG: -1 FRP*2 ; -> ".FR" ** .DO CCOND CLGTP: -1 -1 ERARG ; ERROR FILE RARG1 ; LISTING FILE RARG2 ; SAVE FILE -1 CARG CARG: A.SW ; /A LOCAL 0 CASW O.SW ; /O LOCAL 0 CNSW C.ڸSW ; /C CHANNEL 0 NUMBR K.SW ; /K TASK 0 NUMBR 0 ; /Z LOCAL Z.SW ; FOR ZREL NUMBR ; CONVERT TO NUMBER F.SW ; /F LOCAL 0 ; FOR FOREGROUND NUMBR ; CONVERT TO NUMBER N.SW ; /N LOCAL 0 ; FOR NMAX NUMBR ; CONVERT TO NUMBER 0 ; /O LOCAy L (BY CLI ONLY) 1B10 ; FOR BRACKETS AND COMMA BRKT ; GO THERE -1 FRP*2 0 CASW: LDA 0,AT1D ISZ SSRTN,2 STA 0,SSAC1,2 RTRN 0 CNSW: LDA 0,ST1D JMP CASW+1 FGCX: 1B7 AT1D: AT1 ST1D: ST1 ** .ENDC ; SET /B/N SWITCHES 0 SETBS: LDA 0,CP,2 LDA 1,DBSW C SETSW LDA 1,NSW C SETSW SUBZL 1,1 STA 1,MODE,2 RTRN BSW: 0*400+100 ; CODE FOR /B NSW: 1*400+4 ; CODE FOR /N INVSW: 3*400+20 ; CODE FOR 1B11, LAST SW WORD ; SET 1B11, LAST SWITCH WORD 0 SVSW: LDA 0,PARGP,2 ; PRIMARY ARG NAME PTR LDA 1,INVSW ; INVISIBLE SWITCH C SETSW ; SET SWITCH ON PRIMARY ARG RTRN ; ; MISC. ; ** .NOLOC 1 ASMP: .TXT /ASM/ MACP: .TXT /MAC/ MASMP: .TXT /MASM/ RLDP: .TXT /RLDR/ OVLP: .TXT /OVLDR/ ALGP: .TXT *ALGOL* FORP: .TXT *FORT* FRTRP: .TXT /FORTRAN/ BATP: .TXT /BgATCH/ ** .DO CCOND CLGP: .TXT /CLG/ JBP: .TXT /.JB/ ** .ENDC T TMPP: .TXT /TMP/ ERP: .TXT /.ER/ ** [T] ALP: .TXT *.AL* FRP: .TXT *.FR* SRP: .TXT /.SR/ LSP: .TXT /.LS/ ORP: .TXT /.OR/ PST: .TXT /.PS/ ZP: 0 0 CONSP: .+1*2 TTOP: .TXT /$TTO/ TTO1P: .TXT /$#TTO1/ SVP: .TXT /.SV/ RBP: .TXT /.RB/ OBP: .TXT /.OB/ FCMF: .TXT /FCOM.CM/ LFEP: .TXT /LFE/ ** .DO CCOND LPTP: .TXT /$LPT/ ** .ENDC T TWERP: .TXT /TMP.ER/ SYSP: .TXT /SYSOUT/ ** [T] CDRP: .TXT /$CDR/ ALBP: .TXT /.L1/ OLIN: .TXT /^C^0^F/ ** .NOLOC 0 .END LINKA.SR5 V < ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CLINKA .RB CLINKA.RB ** .ENDC J .TITL BLINKA .RB BLINKA.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CALL ; DEFINE NORM|AL CALL .ENT RCALL ; DEFINE REGISTER CALL .ENT RTRN ; DEFINE RETURN .ENT USE ; STORAGE FOR END OF USER STACK .EXTN STOVE ; STACK OVERFLOW RETURN .ZREL .SAV: SAV .RSAV: RSAVE .RSTR: RSTR .NREL CALL= JSR @.SAV RCALL= JSR @.RSAV RTRN= JSR @.RSTR ; T!HE FOLLOWING ROUTINES FORM THE HEART OF A ; VERSATILE SUBROUTINE COMMUNICATION FACILITY. ; THE GENERAL FORM OF A SUBROUTINE CALL WILL BE ; CALL ; "SUBROUTINE ENTRY POINT" ; I.E. TWO STORAGE WORDS ARE REQUIRED; FIRST A "CALL" AND SECOND ; THE SUBROUTINE EF6NTRY POINT ADDRESS. IF THE SUBROUTINE IS NOT ; ASSEMBLED WITH THE CALLING PROGRAM, IT MUST BE DECLARED AS A ; NORMAL EXTERNAL (.EXTN). ; THE GENERAL FORM OF A SUBROUTINE RETURN IS ; RTRN ; I.E. ONE INSTRUCTION IS REQUIRED AND RETURN IS MADE TO ; THE INSTRUCTION FOLLOWING THE TWO WORD "CALL". ; (NOTE. SEE BELOW FOR A MEANS OF RETURNING TO OTHER INSTRUCTIONS.) ; THE "CALL" WILL PRESERVE CARRY, AC0, AC1, AC2, AS WELL AS THE ; RETURN ADDRESS ON THE CURRENT STACK ENTRY FOR THE CALLING ROUTINE. ; A CURRENT SHTACK ENTRY WILL BE ASSOCIATED WITH EACH LEVEL TO WHICH ; CONTROL IS PASSED, I.E. WITH EACH SUBROUTINE. EACH SUBROUTINE ; MUST USE ITS STACK ENTRY FOR ALL TEMPORARY STORAGE THAT IS ; REQUIRED. FURTHER, VARIABLE PARAMETERS THAT ARE PASSED ; TO LOWER LEVEL? SUBROUTINES MUST BE PASSED ON THE STACK. THE ; LENGTH OF TEMPORARY STORAGE THAT IS REQUIRED BY A ROUTINE ; MUST BE GIVEN BY THE WORD PRECEEDING THE ENTRY POINT. FOR EXAMPLE, ; CALL ; SUBR ; . ; . ; . ; 40 ; 32 DECIMAL TEMPORARY WORDS REQUIRED BY SUBR ; SUBR: ; SUBROUTINE ENTRY POINT ; UPON ENTRY TO THE CALLED ROUTINE, AC3 WILL CONTAIN A POINTER TO THE ; CALLED ROUTINE'S STACK FRAME. THE PAGE ZERO WORD "USP" ; WILL ALSO C@NTAIN THIS POINTER. ; AC2 WILL POINT TO THE CALLING ROUTINE'S STACK FReAME. IF AC2 IS ; DESTROYED, THIS POINTER IS AVAILABLE IN THE CURRENT ; STACK FRAME AT DISPLACEMENT "SSOSP", E.G. LDA 2,SSOSP,3 CAN BE USED ; TO LOAD THE OLD STACK POINTER ASSUMING AC3 CONTAINS THE CURRENT ; STACK POINTER. ; AC0 AND AC1 WILL BE UNCHANGED FROM THE CALLING ROUTINE. THESE ; TWO REGISTERS CAN BE USED TO PASS PARAMETERS TO THE CALLED ; ROUTINE. NOTE THAT TO RETURN RESULTS IN THEM IT IS NECESSARY ; TO OVERWRITE THE LOCATIONS "SSAC0" AND "SSAC1" IN THE OLD ; (CALLERS) STACK FRAME. ; A SECOND݊ FORM MAY BE USED FOR "REGISTER" CALLS. ; ITS FORM IS SIMPLY ; RCALL ; IT IS IDENTICAL TO "CALL" IN EVERY RESPECT EXCEPT THE SUBROUTINE ; ADDRESS MUST BE PROVIDED IN AC2 INSTEAD OF AFTER THE "CALL." ; PARAMETERS TO THE CALLED ROUTINE CAN BE PASSED IN THr!REE WAYS: ; 1.) IN REGISTERS AC0 AND AC1 AS MENTIONED ABOVE. ; 2.) IF THEY ARE VARIABLE, THEY CAN ALSO BE PASSED IN THE ; CALLING ROUTINE'S STACK. ; 3.) IF THEY ARE FIXED, THEY MAY BE PASSED AFTER THE ; CALLING SEQUENCE. A SYSTEM DEFINED DISPLACEMENT CAdULLED ; "SSRTN" CAN BE USED IN CONJUNCITON WITH THE OLD STACK POINTER ; TO ACCESS THE RETURN ADDRESS. THIS ADDRESS IS SETUP ; BY "CALL" TO POINT TO THE FIRST WORD AFTER THE SUBROUTINE NAME. ; E.G. A SINGLE PARAMETER COULD BE PICKED UP BY A LDA 0,@SSRTN,2  ; UPON ENTRY TO THE CALLED ROUTINE. NOTE THAT THE RETURN, ; "RTRN" ALWAYS RETURNS INDIRECTLY THROUGH "SSRTN", AND THEREFORE ; IT IS NECESSARY TO INCREMENT THE RETURN ADDRESS TO AVOID ; ANY PARAMETERS THAT ARE PASSED AFTER THE "CALL". THIS CAN BE ; DONE FBY AN ISZ SSRTN,2 (PROVIDED AC2 CONTAINS THE OLD STACK ; POINTER). NOTE THAT THIS TECHNIQUE CAN ALSO BE USED TO CON- ; DITIONALLY RETURN CONTROL TO THE CALLING ROUTINE. ; TEMPORARY STORAGE (TO THE EXTENT SET UP BY ; THE LENGTH WORD PRECEEDING THE ENTRYg POINT) CAN BE USED BY THE ; SUBROUTINE STARTING AT A DISPLACEMENT OF 1 FROM THE CURRENT STACK ; POINTER. CARE SHOULD BE EXERCISED WHEN PASSING PARAMETERS TO ; ANOTHER ROUTINE, AS THESE MAY DESTROY SOME TEMPORARY STORAGE. SAV: STA 2,@USP ; SAVE AC2 LDA 2,USP ; NOW USE IT FOR CURRENT STACK POINTER STA 0,SSAC0,2 ; SAVE AC0 STA 1,SSAC1,2 ; AND AC1 STA 3,SSRTN,2 ; AND THE RETURN ADDRESS ISZ SSRTN,2 ; BUMP PAST THE SUBROUTINE ADDRESS LDA 3,0,3 ; THE CALLED ROUTIN ADDRESS SAVE1: STA 3,SSEAD,2 ; SAVE 1IT IN THE STACK LDA 1,SSCNT,3 ; GET THE VARIABLE LENGTH OF THE CALLED FRAME STA 1,SSCRY,2 ; SAVE IT LDA 3,SSFL ; FIXED LENGTH OF STACK FRAME LDA 0,SSLGT,2 ; LENGTH OF THE VARIABLE AREA ; OF THE STACK FRAME ADD 0,3 ADD 2,3 ; AC3 POINTS TO NEW STA%CK FRAME STA 3,USP ; SET NEW CURRENT STACK POINTER MORST: ADD 3,1 ; TEST FOR STACK OVERFLOW LDA 0,USE ; END OF STACK SUBZ# 0,1,SNC ; ANY STACK LEFT ? JMP STKOK ; YES  LDA 0,C400 ; NO - ADD 400 MORE WORDS MORS1: S MEMI JMP PANIC ; ITS ALL OVER STA 1,USE ; UPDATE STACKEND LDA 1,SSCRY,2 ; TRY AGAIN JMP MORST STKOK: LDA 1,SSCRY,2 ; GET VARIABLE LENGTH OF CALLED PROG FRAME STA 1,SSLGT,3 ; STORE IN NEW FRAME STA 2,SSOSP,3 ; STORE OLD STACK POINTER IN NEW FRAME MOVL 1,1 STA 1,SSCRY,2 ; SAVE CARRY IN (OLD FRAME MOVR 1,1 ; RESTORE CARRY FOR CALLED PROG LDA 0,SSAC0,2 ; RESTORE AC0 AND AC1 LDA 1,SSAC1,2 JMP @SSEAD,2 ; ENTER CALLED ROUTINE RSAVE: STA 2,@USP ; SAVE AC2 LDA 2,USP ; NOW USE IT FOR CURRENT STACK POINTER STA 0,SSAC0,2 ; SAVE AC0 STA 1,SSAC1,2 ; SAVE AC1 STA 3,SSRTN,2 ; SAVE RETURN ADDRESS LDA 3,@USP ; AC2 CONTAINS THE SUBROUTINE ADDRESS JMP SAVE1 RSTR: LDA 3,USP ; POP CURRENT STACK LDA 0,USE ; TOO MUCH STACK ? SUB 3,0 ; AMT UNUSED LDA 1,C1000 ; EXCESS ALLOWED ADCZ 1,0,SNC JMP SOK ; ALL OK NEG 0,0 ; DECREMENT S MEMI JMP PANIC ; ??? STA 1,USE ; NEW STACK END SOK: LDA 3,SSOSP,3 ; OLD STACK PTR STA 3,USP LDA 0,SSCRY,3 MOVR 0,0 ; RESTORE CARRY LDA 0,SSAC0,3 ; RESTORE AC0 LDA 1,SSAC1,3 ; AC1, LDA 2,SSAC2,3 ; AND !AC2 JMP @SSRTN,3 ; RETURN TO CALLING ROUTINE PANIC: JMP @.+1 STOVE USE: 0 C400: 400 C1000: 1000 SSFL: 10 ; LENGTH OF FIXED PORTION OF STACK FRAME ENTRY SSCNT= -1 ; THE LENGTH OF THE VARIABLE AREA REQUIRED FOR THE ; CALLED ROUTINE IS STORED IN T2HE WORD PRECEEDING THE ; ENTRY POINT .END TUNE.SR5 V T; TUON WILL CREATE A FILE CALLED WHERE SYS IS ; THE MASTER DEVICE. ; ; TUOFF WILL SHUT OFF TUNING MONITOR ; ; TPRINT WILL PRINT OUT ; GLOBAL SWS ; /L PRINT TO LPT ; /O PRINT OVERLAY INFOMATION ; ** .NOCON NO.CON ; DON'T LIST CONDITI)ONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CTUNE .RB CTUNE.RB ** .ENDC J .TITL BTUNE .RB BTUNE.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT TUON .ENT TUOFF .ENT TPRINT .EXTN LDBT STBT TIMR .EXTN( WRLCH WRLIN .EXTN INDEX ; INDEX ROUTINE .EXTN CALL RTRN .EXTN GETAR GETSW .EXTN VRFIL LSUCH= COMCH ; LISTING CHANNEL ** .DO CCOND TUCH= PUSCH ; TUNING FILE CHANNEL ** .ENDC J TUCH= TMPCH ; TUNING FILE CHANNEL **[J] 0 TUON: ISZ SSRTN,2 S TUON K JMP @OPER RTRN 0 TUOFF: ISZ SSRTN,2 S TUOFF JMP @OPER RTRN OPER: TERT1 ; DEFINE THE STACK TMP= 1 ; TMP FOR ALL KINDS OF THINGS CP= TMP+1 ; ARG POINTER VERIF= CP+1 ; CHANNEL NUMBER FOR LISTING OSW= VERIF+1 ; /O SWITCH DATAP= OSW+1 ; POINTER' TO DATA AREA NAMEP= DATAP+1 ; POINTER TO FILE NAME COUNT= NAMEP+1 ; NUMBER OF --- IN SYSTEM OR OVERLAY # REQUE= COUNT+1 ; NUMBER OF REQUESTS FAULT= REQUE+2 ; NUMBER OF FAULTS OVREQ= FAULT+2 ; TOTAL NUMBER OF OVERLAY REQUESTS PERSF= OVREQ+2 ; PERCENT, OF FAULTS TPERS= PERSF+1 ; PERCENT OF TOTAL OVERLAY REQUESTS NAME= TPERS+1 ; STORAGE FOR FILE NAME STACK= NAME+30 ; STACK SIZE STACK TPRINT: ISZ SSRTN,2 ; ASSUME GOOD RETURN C GETSW ; GET GLOBAL SWITCHES STA 0,CP,3 ; SAVE ARG POINTER SW O ; TESDT O SWITCH SETVR VERIF ; TAKE CARE OF VERIFY STUFF SNZ VERIF ; ASK FOR ANY ? ISZ VERIF,3 ; NO GIVE HIM DEFAULT BPT NAME NAMEP ; FORM POINTER TO NAME SPACE LDA 0,CP,3 ; RESTORE POINTER C GETAR JMP TDELF ; NOT THERE TRY DEFAULT TPRI1: LDA 2,NAMEP,3 ; XPLACE TO BUILD NAME LDA 1,TUEX ; .TU EXTENTION C VRFIL ; VERIFY ITS EXISTANCE JMP @TERRO ; NOT THERE TOO BAD JMP TPRI3 ; GOT IT CONTINUE TDELF: MOV 1,0 ; TRY FOR DEFAULT NAME S GSYS ; GET THE SYSTEM NAME MOVZR 1,2 ; WIPE OUT EXTENTION SUB 1,1 Ѿ STA 1,SCEXT,2  JMP TPRI1 ; SEE IF IT EXISTS TERRO: TERTN TUEX: TUNEX*2 TPRI3: MOV 2,0 ; OPEN INPUT CHANNEL SUB 1,1 S OPEN TUCH JMP @TERRO ; GOOD TRY LDA 1,KPER ; WIPE OUT EXTENTION ON NAME C INDEX NOP SUB 1,1 C STBT LDA 0,TITLL ; PUT OUT TITLE LINE WRVER VERIF NAMEP C TIMR LDA 2,HTABL ; NOW REST OF HEADER TPRI4: LDA 0,0,2 ; GET A LINE INC 2,2 COM# 0,0,SNR ; END OF TABLE ?? JMP TPRI5 ; YES CONTINUE WITH DATA WRVER VERIF ; NO WRITE IT OUT JMP TPRI4 ; AND GET NEXT TITLL: TITLE*2 HRTABL: HEADT KPER: ". TPRI5: BPT COUNT DATAP ; FORM POINTER TO DATA AREA MOV 1,0 LDA 1,C2 S RDS TUCH ; SKIP GERBADGE WORD JMP @.REDER LDA 2,MAINT ; AC2 -> FORMAT LINE TABLE STA 2,TMP,3 ; SAVE IT TPRI6: LDA 0,DATAP,3 ; READ A SET OF DATA LDA 1,TDSI^Z ; # OF BYTES S RDS TUCH JMP @.REDER C DPPER ; CALCULATE PERCENTAGE OF FAULTS FAULT REQUE STA 1,PERSF,3 ; SAVE IT LDA 0,@TMP,3 ; GET THE FORMAT LINE ISZ TMP,3 WRVER VERIF ; SEND THE LINE COUNT REQUE REQUE+1 FAULT FAULT+1 PERSF LDA 0,NULP ; SEND A BLANK LINE WRVER VERIF LDA 2,@TMP,3 ; END OF THIS PASS ? COM# 2,2,SZR JMP TPRI6 ; NO DO ANOTHER ONE LDA 0,FAULT,3 ; SAVE # OF OVERLAY FAULTS STA 0,OVREQ,3 LDA 0,FAULT+1,3 STA 0,OVREQ+1,3 SNZ OSW ; OVERLAYS ?? JMP @TPRTN ; NO RETURN JMP TOVP ; YES GO TO IT C2: 2 .REDER: TERTN TDSIZ: .TUNX*2 NULP: NULLI*2 MAINT: FORMT ; FORMAT TABLE TPRTN: TRETU TOVP: LDA 0,COUNT,3 ; SAVE COUNT OF OVERLAYS STA 0,TMP,3 BPT REQUE DATAP ; NEW READ IN AREA SUB 0,0 STA 0,COUNT,3 ; CLEAR OVERLAY NUMBER LDA 1,C512 ; POSITION TO OVERLAY INFO S SPOS TUCH JMP @.OVRER LDA 0,FFLIN ; NEW PAGE WRVER VERIF LDA 0,OVTIT ; PUT OUT TITLE WRVER VERIF NAMEP C TIMR ; PUT OUT DATE TIME LDA 2,OHEAD ; PUT OUT REST OF HEADER TOVP1: LDA 0,0,2 INC 2,2 COM# 0:,0,SNR ; DONE ? JMP TOVP2 ; YES START DATA WRVER VERIF ; NO PUT OUT LINE JMP TOVP1 ; GET NEXT LINE TOVP2: LDA 0,DATAP,3 ; READ IN DATA LDA 1,OVTLN ; LENGTH OF ENTRY S RDS TUCH JMP @.OVRER C DPPER ; GET FAULT PERCENT FAULT ; FAULTS REQUE ; REf:QUESTS STA 1,PERSF,3 ; SAVE THEM C DPPER ; GET PERCENT OF TOTAL FAULTS FAULT OVREQ STA 1,TPERS,3 LDA 0,OVFMT ; FORMAT LINE WRVER VERIF COUNT ; OVERLAY NUMBER REQUE ; REQUESTS REQUE+1 FAULT ; FAULTS FAULT+1 PERSF TPERS ISZ COUNT,3 DSZ TMP,3 ; DONE ? JMP TOVP2 ; NO CONTINUE JMP TRETU ; YES RETURN C512: 512. FFLIN: FORMF*2 .OVRER: TERTN OVTIT: OVTTL*2 OHEAD: OVHEA OVTLN: 10 OVFMT: OVLIN*2 TRETU: S CLOS TUCH ; CLOSE THE INPUT CHANNEL NOP LDA 2,VERIF,3 MOVZR# 2,2,SNR ; $LPT OPEN ?? 4RTRN ; NO QUIT S CLOS CPU ; YES CLOSE IT NOP RTRN ; QUIT TERTN: LDA 0,NAMEP,3 TERT1: ER1 3 JMP TRETU FERTN: LDA 3,SSOSP,3 DSZ SSRTN,3 JMP TRETU ** .NOLOC 1 TUNEX: .TXT /.TU/ TITLE: .TXT /^T<10.>SYSTEM TUNING REPORT FOR ^C^T<50.>/ NULLI: .TXT /<15>/ FORMF: .TXT /<14>/ OVTTL: .TXT /^T<10.>OVERLAY TUNING REPORT FOR ^C^T<50.>/ OVLIN: .TXT /OVERLAY # ^O^B<2>^T<14.>^P^B<10.>^T<27.>^P^B<10.>^T<42.> ^D^B<4> %^T<53.>^D^B<4> %<15>/ OVH1: .TXT /^T<16.>NUMBER OF^T<29.>NUMBER OF^T<41.>PERCENTAGE ^T<5t4.>PERCENTAGE OF<15>/ OVH2: .TXT /^T<16.>REQUESTS^T<29.>FAULTS^T<41.>FAULTED ^T<54.>TOTAL FAULTS<15>/ STTM: .TXT /STACKS^T<17.>^D^B<3>^T<26.>^P^B<10.>^T<38.>^P^B<10.> ^T<55.>^D^B<4> %<15>/ CETM: .TXT /CELLS^T<17.>^D^B<3>^T<26.>^P^B<10.>^T<38.>^P^B<10.> ^T<55.>^D^B<4> %<15>/ BUTM: .TXT /BUFFERS^T<17.>^D^B<3>^T<26.>^P^B<10.>^T<38.>^P^B<10.> ^T<55.>^D^B<4> %<15>/ OVTM: .TXT /OVERLAYS^T<17.>^D^B<3>^T<26.>^P^B<10.>^T<38.>^P^B<10.> ^T<55.>^D^B<4> %<15>/ HMS1: .TXT /^T<17.>NUMBER IN^T<30.>TOTAL^T<43.>NUMBER OF ^T<55.>PERCENTAGE<15>/ HMS2: .TXT /^T<17.>SYSTEM^T<30.>REQUESTS^T<43.>FAULTS ^T<55.>FAULTED<15>/ ** .NOLOC 0 FORMT: STTM*2 CETM*2 BUTM*2 OVTM*2 -1 HEADT: HMS1*2 HMS2*2 NULLI*2 -1 OVHEA: OVH1*2 OVH2*2 NULLI*2 -1 ; ; DOUBLE PERCSION PERCENTAGE DPPER ; ; ; RETURNS RESULT IN AC1 ; DVDN1= +1 DVDN2= DVDN1+1 DVSR1= DVDN2+1 DVSR2= DVSR1+1 QUOT2= DVSR2+1 COUNT= QUOT2+1 STAK=COUNT STAK DPPER: LDA 0,@SSRTN,2 ; GET STACK DISPLACEMENT ISZ SSRTN,2 ; BUMP RETURN ADD 0,2 ; MAKE IT iADDRESS LDA 0,0,2 ; GO BACK AND GET THOSE PARAMS LDA 1,1,2 STA 0,DVDN1,3 STA 1,DVDN2,3 LDA 2,SSOSP,3 ; GET THE OLD STACK POINTER LDA 0,@SSRTN,2 ; GET STACK DSIPLACEMENT TO DIVISOR ISZ SSRTN,2 ADD 0,2 ; MAKE IT ADDRESS LDA 0,0,2 LDA 1,1,2 STA 0,sODVSR1,3 STA 1,DVSR2,3 LDA 2,DVDN2,3 MOV 2,2,SZR ; DIVIDING INTO ZERO ? JMP DPPE1 ; NO LDA 2,DVDN1,3 ; MAYBE MOV 2,2,SNR JMP DPRTN ; YEP DON'T BOTHER DPPE1: LDA 2,DVDN1,3 SUBZ# 2,0,SNC ; OVERFLOW ?? JMP DP100 ; OVERFLOW MAKE IT 100 % SUB# 2,0,S;ZR ; = ? JMP DPPE2 ; NO CONTINUE LDA 2,DVDN2,3 ; YES TEST OTHER HALF OF WORD SUBZ# 2,1,SNR ; IT = ? JMP DP100 ; YES 100 % DPPE2: LDA 0,C32 ; SET THE DP COUNTER STA 0,COUNT,3 SUBO 0,0 STA 0,QUOT2,3 LDA 1,DVDN1,3 ; GET THE HIGH WORD LOOP: LDA 2,DVDN2,3 MOVL 2,2 STA 2,DVDN2,3 MOVL 1,1 MOVL 0,0 LDA 3,USP LDA 2,DVSR2,3 LDA 3,DVSR1,3 SUB# 3,0,SNC JMP BR2 ADC# 3,0,SNC ; EQ ?? JMP BR3 ; YUP CAN SUB IT OUT BR4: SUB 2,1,SNC ; LT ?? ADCZ 3,0,SKP SUBZ 3,0 ; SUB AND SET CARRY BR2: LDA 3,USP LDHA 2,QUOT2,3 ; PASS TO QOUTE MOVL 2,2 STA 2,QUOT2,3 ; USE DVDN2 FOR QUOT OVERFLOW DSZ COUNT,3 JMP LOOP LDA 2,C100 ; MAKE IT PERCENTAGE LDA 1,QUOT2,3 SUBO 0,0 CALL MPY MOVZL 1,1,SZC ; ROUND OFF INC 0,0 DPRT1: LDA 2,SSOSP,3 STA 0,SSAC1,2 RTRN ;DPRTN: SUB 0,0 JMP DPRT1 BR3: SUB# 2,1,SNC JMP BR2 JMP BR4 DP100: LDA 0,C100 JMP DPRT1 C32: 32. C100: 100. ; ; INTEGER MULTIPLYER .NREL 0 MPY: LDA 3,M20 ; SET COUNTER LDA 2,SSAC2,2 ; GET MULTIPLYER MOVR 1,1,SNC MOVR 0,0,SKP ADDZR 2,0 INi C 3,3,SZR JMP .-4 MOVCR 1,1 LDA 3,USP LDA 2,SSOSP,3 STA 0,SSAC0,2 STA 1,SSAC1,2 RTRN M20: -16. XPAND.SR5 0 ; ; XPAND- ; EXPAND INNER MOST LEVEL OF ANGLE BRACKETS IN ; COMMAND LINE IN INPUT BUFFER INTO OUTPUT BUFFER. ; ; ON ENTRY, AC0 <= ANGLE BRACKET LEVEL FOR EXPANSION ; AC1 => INPUT BUFFER HEADER ; AC2 => OUTPUT BUFFER HEADER ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CXPAND .RB CXPAND.RB ** .ENDC J .TITL BXPAND .RB BXPAND.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT XPAND ; ENTRY POINT .EXTN XGCBUF ; GET CHARACTER FROM BUFFER .EXTN PCBUF ; PUT CHARACTER INTO BUFFER .EXTN CALL RTRN ; LINKING ROUTINES ; DEFINE THE STACK OBUF= 1 ; OUTPUT BUFFER HEADER POINTER IBUF= OBUF+1 ; INPUT BUFFER HEADER POINTER LEVL= IBUF+1 ; ANGLE BRACKET LEVEL IP= LEVL+1 ; INPUT POINTER SAVE1= IP+1 ; SAVED CHARACTERS SAVE2= SAVE1+1 MARK1= SAVE2+1 ; POSITION IN LINE MARKERS MARK2= MARK1+1 TABL= MARK2+1 ; ADDRESS OF TABLE BEING PROCESSED DOITR= TABL+1 ; RETURN ADDRESS FOR TABLE PROCESSOR CHAR= DOITR+1 ; LAST ^)CHARACTER READ FROM INPUT BUFFER CMAND= CHAR+1 ; CURRENT TABLE COMMAND WORD CURTB= CMAND+1 ; CURRENT PRIMARY TABLE CURTN= CURTB+1 ; RETURN TO CURRENT PRIM. PROCESSOR STACK= CURTN ; STACK SIZE STACK XPAND: STA 1,IBUF,3 ; SAVE INPUT POINTER STA 0,LE3VL,3 ; SAVE < LEVEL LDA 2,SSAC2,2 ; SAVE OUTPUT BUFFER STA 2,OBUF,3 MOV 1,2 LDA 0,BFRPT,2 ; SAVE INPUT BUFFER POINTER STA 0,IP,3 STA 0,MARK1,3 ; INITIALZE MARK1 CLER SAVE1 SAVE2 MARK2 TB1PR: LDA 1,TABL1 ; AC1 => TAB 1 JSR DOIT ; PROCESS TABLE 1 T<7B2PR: LDA 1,TABL2 ; AC1 => TAB 2 JSR DOIT ; PROCESS TABLE 2 DSZ MARK1,3 ; WASN'T (<>) SO PUSH BACK NOP ; MARK1 TO LPAR, CLER MARK2 ; RE-INITIALIZE MARK2 JMP TB1PR ; AND CONTINUE WITH TABLE 1. TB3PR: DSZ LEVL,3 ; INNER MOST < ? JMP TB3P2 ; NO- CONTINUE WITH CURRENT TABLE LDA 0,MARK2,3 ; COME FROM TABLE TWO ?? MOV 0,0,SZR STA 0,MARK1,3 ; YES- SET PROPER POINTER TB3P1: LDA 1,TABL3 ; AC1 => TAB 3 JSR DOIT ; PROCESS TABLE 3 TB3P2: LDA 1,IP,3 ; MARK THIS POSITION STA 1,MARK1,3 ; AT MARK1. LDA 1,CH$bAR,3 ; AC1 <= CHARACTER LDA 2,OBUF,3 ; AC2 => OUTPUT BUFFER HEADER C PCBUF ; STORE IN OUTPUT BUFFER AND JMP LOOP ; GO GET NEXT INPUT CHARACTER. TB4PR: LDA 1,TABL4 ; AC1 => TAB 4 JSR DOIT ; PROCESS TABLE 4 TB5PR: LDA 1,TABL5 ; AC1 => TAB5 JSR DOIT ;f( PROCESS TABLE 5 TB6PR: LDA 1,TABL6 ; AC1 => TAB6 JSR DOIT ; PROCESS TABLE 6 TB7PR: LDA 0,MARK2,3 ; GET CONTINUATION POINTER STA 0,IP,3 ; START HERE FOR EXPANSION JMP TB3P1 ; CONTINUE SCAN USING TAB3 TABL1: TAB1 TABL2: TAB2 TABL3: TAB3 TABL4: TAB4 TA BL5: TAB5 TABL6: TAB6 ; ; SKIP TABLE PROCESSORS ; SKIP1: LDA 1,SK1TB ; AC1 <= TABLE ADDRESS JMP SKIPP ; GO PROCESS SKIP TAB 1 SKIP2: LDA 1,SK2TB ; AC1 <= TABLE ADDRESS JMP SKIPP ; GO PROCESS SKIP TAB 2 SKIP3: LDA 1,SK3TB ; AC1 <= TABLE ADDRESS SKIPfP: LDA 2,TABL,3 ; SAVE CURRENT PRIMARY TABLE STA 2,CURTB,3 ; IN STACK. LDA 2,DOITR,3 ; SAVE CURRENT RETURN TO PRIMARY STA 2,CURTN,3 ; PROCESSOR IN STACK. JSR DOIT ; PROCESS SKIP TABLE LDA 0,CURTN,3 ; AC0 <= PRIMARY RETURN LDA 1,CURTB,3 ; AC1 => PRIMA -RY COMMAND TABLE JMP CONTB ; CONTINUE PROCESSING IT ; MISCELLANEOUS COMMAND PROCESSORS NEXT: LDA 1,MARK1,3 ; GET SAVED INPUT POINTER STA 1,IP,3 ; USE IT AS CURRENT INPUT POINTER LDA 1,SAVE2,3 ; STORE TERMINATING CHARACTER LDA 2,OBUF,3 ; GET OUTPUT BUFFER ADDRESS C PCBUF JMP TB6PR ; CONTINUE USING TAB 6 POPER: JMP @DOITR,3 ; RETURN FROM DOIT SUBROUTINE FINISH: RTRN ; RETURN TO CALLING PROGRAM SK1TB: S1TB SK2TB: S2TB SK3TB: S3TB ; ; DOIT- ; PROCESS INPUT STRING AS DRIVEN BY TABLE ; ON ENTRY, A'C1 => TABLE TO BE PROCESSED ; DOIT: MOV 3,0 ; SAVE RETURN ADDRESS LDA 3,USP ; RESTORE OUR STACK POINTER CONTB: STA 0,DOITR,3 ; SAVE RETURN ADDRES ON STACK STA 1,TABL,3 ; SAVE TABLE ADDRESS LOOP: ADC 1,1 STA 1,SAVE1,3 ; MARK SAVE WORD LDA 2,IBUF,3 ; GET NEXT CHARACTER LDA 0,IP,3 ISZ IP,3 ; BUMP POINTER C GCBUF STA 1,CHAR,3 ; SAVE THE CHARACTER LDA 3,TABL,3 ; GET TABLE ADDRESS LDA 2,C377 DOIT1: LDA 0,0,3 ; GET AN ENTRY AND 2,0 ; MASK OUT NOISE SUB# 1,0,SZR ; MATCH ?? SUB# 2,0,SNR ; WELL ?? JMP MATCH ; YES GO PROCESS IT INC 3,3 ; NO GET NEXT ENTRY JMP DOIT1 ; AND TRY AGAIN MATCH: LDA 0,0,3 ; GET COMMAND WORD LDA 3,USP STA 0,CMAND,3 ; SAVE COMMAND WORD MOVZL 0,0,SZC ; SAVE 1 ? STA 1,SAVE1,3 ; YES DO IT MOVZL 0,0,SZC ; SAVE 2 ? ST,A 1,SAVE2,3 ; YES DO IT LDA 1,IP,3 ; GET POINTER MOVZL 0,0,SZC ; MARK1 ? STA 1,MARK1,3 ; YES DO IT MOVZL 0,0,SZC ; HOW ABOUT MARK 2 STA 1,MARK2,3 ; YES DO IT LDA 1,SAVE1,3 ; ANYTHING TO PUT AWAY COM# 1,1,SNR ; WELL ?? JMP DOIT3 ; NO CONTINUE  LDA 2,OBUF,3 C PCBUF ; STORE THE CHARACTER IN OUTPUT BUFF DOIT3: LDA 1,CMAND,3 ; RESTORE COMMAND WORD LDA 0,CMASK ANDS 0,1 ; GET TABLE DISPLACEMENT  LDA 2,CTABL ; GET TABLE ADD 1,2 ; AC2 => COMMAND ROUTINE ADDRESS JMP @0,2 ; GO TO ROUTINE CMASK: 1B7B7 C377: 377 CTABL: COMTB ; COMMAND DISPATCH TABLE COMTB: 0 LOOP ; GET NEXT CHARACTER FINISH ; FINISHED WITH EXPANSION POPER ; TAKE DOIT RETURN SKIP1 ; COPY TILL ") SKIP2 ; COPY TILL QUOTE SKIP3 ; COPY TILL "> NEXT ; PROCESS NEXT ITTERAT9UION 0 TB1PR ; PRIMARY TABLE PROCESSORS TB2PR TB3PR TB4PR TB5PR TB6PR TB7PR ; DEFINE THE COMMAND CHARACTERS LPAR= "( RPAR= ") COMA= ", SPAC= 40 LCAR= "< RCAR= "> QUOTE= 42 END= 377 ; DEFINE THE COMMAND CODES ST1= 1B0 ; SAVE CHAR AT S AVE1 ST2= 1B1 ; SAVE CHAR AT SAVE2 MK1= 1B2 ; MARK POSITION AT MARK 1 MK2= 1B3 ; MARK POSITION AT MARK2 LP= 1B7 ; GET NEXT CHARACTER FIN= 2B7 ; FINISHED POP= 3B7 ; POP TO CALLER SK1= 4B7 SK2= 5B7 SK3= 6B7 NXT= 7B7 TB1= 11B7 ; TABLE PROCESSING CO+DES TB2= 12B7 TB3= 13B7 TB4= 14B7 TB5= 15B7 TB6= 16B7 TB7= 17B7 ; PRIMARY COMMAND TABLES TAB1: LPAR+ST1+MK1+TB2 SPAC+ST1+MK1+LP COMA+ST1+MK1+LP SEMI+ST1+FIN EOL+ST1+FIN LCAR+TB3 QUOTE+ST1+SK2 END+ST1+LP TAB2: RPAR+ST1+POP SPAC+ST1+MK2+LP COMA+ST1+MK2+LP LCAR+TB3 QUOTE+ST1+SK2 END+ST1+LP TAB3: LPAR+ST1+SK1 COMA+ST2+MK2+TB4 SPAC+ST2+MK2+TB4 RCAR+TB1 QUOTE+ST1+SK2 END+ST1+LP TAB4: RCAR+TB5 END+LP TAB5: EOL+NXT SEMI+NXT SPAC+NXT COMA+NXT RCAR+NXT LCAR+ST1+SK3 LPAR+ST1+SK1 SRPAR+NXT QUOTE+ST1+SK2 END+ST1+LP TAB6: LCAR+TB7 END+ST1+LP ; SKIP COMMAND TABLES S1TB: RPAR+ST1+POP END+ST1+LP S2TB: QUOTE+ST1+POP END+ST1+LP S3TB: RCAR+ST1+POP END+ST1+LP TIMR.SR5 V{t ; GET TOD AND TYPE OUT ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CTIMR .RB CTIMR.RB ** .ENDC J .TITL BTIMR .RB BTIMR.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .EN2T TIMR .EXTN CALL RTRN WRLCH HOUR=1 MIN=2 SEC=3 YEAR= 4 MONTH= 5 DAY= 6 CHN= DAY+1 CHN TIMR: STA 1,CHN,3 S GDAY JMP ERC STA 0,DAY,3 STA 1,MONTH,3 LDA 1,BFYR ADD 1,2 STA 2,YEAR,3 S GTOD ; GET FROM SYSTEM JMP ERC STA 2,HOUR,3 STA 1,MIN,f3 STA 0,SEC,3 LDA 1,CHN,3 ; OUTPUT CHANNEL LDA 0,TIMSG C WRLCH MONTH DAY YEAR HOUR MIN SEC LDA 0,CR ; SKIP TWO LINES C WRLCH C WRLCH RTRN BFYR: 68. TIMSG: .+1*2 ** .NOLOC 1 .TXT *^D^Z<2>/^D^Z<2>/^D^Z<2> ^D^Z<2>:^D^Z<2>:^D^Z<2><15>* ** .NO/ZLOC 0 ERC: ER2 4 RTRN RTRN CR: .+1*2 15B7 VRFIL.SR5 V? ; ; ROUTINE TO VERIFY AN INPUT FILE ; INPUTS: ; AC0 -> FILE NAME ; AC1 -> FILE NAME EXTENSION ; AC2 -> COMPOSITITE FILE NAME ; ; CALL ; VRFIL ; - ERROR ; - NORMAL RETURN ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACR4O EXPANSIONS ** .DO CCOND==1 .TITL CVRFIL .RB CVRFIL.RB ** .ENDC J .TITL BVRFIL .RB BVRFIL.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT VRFIL MKFIL MKNAM MKFLA .EXTN MOVE INDEX LDBT .EXTN CALL RTRN .INDEX FNP=1 ; FILE NAME PTR (AC0u) EXTP=2 ; EXT PTR (AC1) CFNP=3 ; COMPOSOTE PTR (AC2) APF=4 ; APPEND FLAG STAT=APF+1 ; FILE STATUS SPACE STSIZ=STAT+UFDEL; STACK SIZE STSIZ VRFIL: LDA 2,SSAC2,2 ; LOAD AC2 (POINTER) C MKNAM ; BUILD COMPOSITITE NAME STA 0,FNP,3 ; SAVE NAME PTR N LDA 1,PER ; LOOK FOR PERIOD C .INDEX MOV 2,0,SKP ; FULL NAME PTR JMP EXTF SUB 1,1 STA 1,STAT+UFTAT,3 ; CLEAR ATTRIBUTE WORD LDA 1,STD ; STATUS SPACE DISPLACEMENT ADD 3,1 ; MAKE ADDRESS S RSTAT ; GET FILE INFORMATION JMP .+2 ; ASSUME NOT THERE  JMP FOUND ; GOTCHA MOV 0,1,SKP ; TO PTR EXTF: MOV 2,1,SKP LDA 0,FNP,3 ; FROM PTR C MOVE ; JUST NAME LDA 0,FNP,3 LDA 1,STD ADD 3,1 ; MAKE ADDRESS OF STATUS SPACE S RSTAT ; GET FILE STATUS JMP ERRET FOUND: LDA 0,STAT+UFTAT,3 ; GET FILE ATTRIBUTES3g LDA 1,RDATR ; SEE IF ITS READABLE AND 0,1,SZR JMP ARET RET: LDA 2,SSOSP,3 ISZ SSRTN,2 RTRN ARET: LDA 2,RDER ERRET: MOV 2,1 LDA 2,SSOSP,3 STA 1,SSAC2,2 RTRN RDER: ERRPR WRER: ERWPR STD: STAT ; ; ROUTINE TO MAKE AN OUTPUT FILE ; INPUTS: ; AC0 -> FFILE NAME ; AC1 -> FILE NAME EXTENSION ; AC2 -> COMPOSITITE FILE NAME ; ; CALL ; MKFIL ; - ERROR ; - NORMAL RETURN STSIZ MKNAM: ADCO 0,0 ; ONLY MAKE NAME OF NAME AND EXT JMP MKFIL+1 STSIZ MKFLA: SUBO 0,0 ; MAKE NAME AND WRITE-VERIFY JMP MKFIL+1 STSIZ MKFIL: SUBZL 0,0 ; MAKE NAME, CREATE(RECREATE), AND WRITE-VERIFY STA 0,APF,3 ; KEEP ENTRY FLAG LDA 0,SSAC0,2 ; NOW GET ORIGINAL AC0 STA 0,FNP,3 ; SAVE INPUT ARGS STA 1,EXTP,3 LDA 1,SSAC2,2 STA 1,CFNP,3 CALL ; MOVE NAME TO OUTPUT STRING MOVE L~DA 0,CFNP,3 ; WHERE NAME IS  LDA 1,EXTP,3 ; EXT PTR MOV# 1,1,SNR ; SEE IF EXT IS NULL JMP NOEXT ; DONT ADD AN EXT LDA 1,PER ; LOOK FOR PERIOD OR END OF NAME C INDEX JMP .+1 MOV 0,1 LDA 0,EXTP,3 ; EXT PTR C MOVE ; ADD ON EXT LDA 0,CFNP,3 NOEXT: MOGV# 0,0,SZC RTRN LDA 1,APF,3 ; GET ENTRY FLAG MOV# 1,1,SNR JMP CRE ; DONT DISTURB EXISTING ONE S DELE JMP .+1 CRE: S CRAN ; TRY TO CREATE FILE JMP ERX ; ALREDY THERE GSTAT: LDA 1,STD ADD 3,1 ; MAKE ADDR OF STAT AREA S RSTAT JMP ERRET LDA 0,GSTAT+UFTAT,3 ; GET FILE ATTRIBUTES LDA 1,WRATR ; SEE IF ITS WRITABLE AND 0,1,SNR JMP RET LDA 2,WRER JMP ERRET ERX: LDA 1,APF,3 ; GET ORIGIN FLAG MOV# 1,1,SZR ; MKFLA IGNORES .STAT ERROR JMP ERRET ; MKFIL DOESNT JMP GSTAT PER: ". WRATR: ATWP RDATR:DL ATRP .END PRESCAN.SR5 X  ; ; PRESCAN- ; THIS MODULE SCANS A COMMAND TO CHECK FOR ; SYNTACTIC VALIDITY WITH RESPECT TO ANGLE BRACKETS ; AND PARENTHESIS. ; ; IF THE LINE IS SYTACTICALLY CORRECT, IT WILL CALL ; SUBROUTINE "XPAND" IF ANGLE BRACKET EXPANSION IS NECESSARY. ; AFTER ANGLUE BRACKETS HAVE BEEN EXPANDED, IT WILL ; CHECK TO SEE IF THERE ARE PARENTHESIS TO EXPAND. ; IF THERE ARE, IT WILL TAKE THE EXPAND PARENS RETURN. ; ; ON ENTRY, AC2 => COMMAND VIRTUAL BUFFER HEADER ; ON RETURN, THE COMMAND BUFFER WILL CONTAIN THE ; } EXPANDED COMMAND. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CPRESCAN .RB CPRESCAN.RB ** .ENDC J .TITL BPRESCAN .RB BPRESCAN.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT PRESC ; ENTRY POINT .EXTN CALL RTRN GCBUF PCBUF CMDER .EXTN XPAND SBUFR CLBUF IP= 1 ; INPUT POINTER CRP= IP+1 ; COUNT OF < FROM START OF LINE CAPOS= CRP+1 ; POSITION OF DEEPEST NESTED < CARET= CAPOS+1 ; CURRENT LEVEL OF ANGLE BRACKETS NCARET= CARET+1 ; MAXIMUM ANGLE BRACKET ANGLE PARSW= NCARET+1 ; PARENS EXIST SWITCH PARCT= PARSW+1 ; PAREN COUNT PCAET= PARCT+1 ; ANGLE BRACKET COUNT AT ( BRACT= PCAET+1 ; BRACKET COUNT TEXT= BRACT+1 ; TEXT MODE SWITCH BUFR1= TEXT+1 ; POINTER TO BUEFFER1 BUFR2= BUFR1+1 ; POINTER TO BUFFER2 STACK= BUFR2+1 ; STACK LENGTH STACK PRESC: LDA 2,SSAC2,2 ; SAVE BUFFER ADDRESS STA 2,BUFR2,3 LDA 2,SBUFP ; SET UP SCRATCH BUFFER STA 2,BUFR1,3 C CLBUF CLER PARSW ; INIT PARENS EXIST SWITCH PRES0: LDA 2,E7BUFR2,3 LDA 0,BFRPT,2 ; SAVE BUFFER POINTER STA 0,IP,3 CLER CARET NCARE BRACT PARCT CRP CAPOS TEXT NEXTC: LDA 2,BUFR2,3 ; GET A CHARACTER LDA 0,IP,3 ISZ IP,3 C GCBUF DISP PRETA ; DISPATCH ON IT PRETA: .+1 ; CHARACTER DISPATCH TABLE 42 ; QUOTE ( H") TEXTM ; FLIP TEXT MODE SWITCH "< LCAR "> RCAR "( LPRN ") RPRN "[ LBRK "] RBRK EOL ENDL SEMI ENDL -1 ; ANY NON-SPECIAL CHARACTER NEXTC SBUFP: SBUFR ; PROCESS A < LCAR: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE THIS LCAR ISZ CRP,3 ; COUNT LEFT CARRETS LDA 2,CRP,3 ISZ CARET,3 ; UP RUNNING COUNT LDA 0,CARET,3 LDA 1,NCARE,3 SUBZ# 0,1,SNC ; RUNNING > MAX ?? STA 0,NCARE,3 ; YES MAX = RUNNING SUBZ# 0,1,SNC ; RUNNING > MAX ?? STA 2,CAPOS,3 ; YES SAVE POSITION FOR XPAND JMP NEXTC ; PROCESS NEXT CHARACTER ; PROCESS A > RCAR: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE THIS RCAR DSZ CARET,3 ; DOWN WE GO NOP LDA 0,CARET,3 ; CHECK FOR > WITHOUT PRE < COM# 0,0,SNR ; IF IS THEN JMP NECRT ; GIVE <> NO MATCH ERROR ELSE PROCEED JMP NEXTC ; PROCESS NEXT CHARACTER ; PROCESS A ( LPRN: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE THIS LPRN SKZ BRACT ; IN BRACKET MODE ? JMP NESPB ; YES GIVE NESTING ERROR SKZ PARCT ; IN PAREN MODE ? JMP NEPAR ; YES GIVE ERROR ISZ PARCT,3 ; NO BUMP PAREN COUNT ISZ PARSW,3 ; SHOW WE HAVE PARENS LDA 1,CARET,3 ; SAVE CARRET COUNT STA 1,PCAET,3 JMP NEXTC ; GET NEXT CHARACTER ; PROCESS A ) RPRN: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE THIS RPRN DSZ PARCT,3 ; COUNT = COUNT-1 JMP NEPAR ; MUST GO TO ZERO - GIVE ERROR LDA 0,CARET,3 LDA 1,PCAET,3 SUB# 1,0,SNR ; CARRET COUNT SAME AS WHEN ( SEEN ? JMP NEXTC ; YES - ALL IS WELL LDA 2,.CAR1 ; NO - GIVE ILLEGAL NESTING ERROR JMP ER2X ; PROCESS A QUOTE (") TEXTM: LDA 1,TEXT,3 ; PICK UP TEXT MODE SWITCH COM 1,1 ; FLIP THE SWITCH STA 1,TEXT,3 ; AND STORE IT BACK JMP NEXTC ; GET NEXT CHARATER ; PROCESS A [ LBRK: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE THIS LBRK SKZ PARCT ; IN PAREN MODE ? JMP NESP%B ; YES GIVE ERROR SKZ BRACT ; IN BRACKET MODE ALREADY ? JMP NEBRK ; YES GIVE BRACKET ERROR ISZ BRACT,3 ; NO BUMP BRACKET COUNT JMP NEXTC ; CONTINUE WITH CHARACTER FOLLOWING [ ; PROCESS A ] RBRK: SKZ TEXT ; TEXT MODE? JMP NEXTC ; YES- IGNORE T HIS RBRK DSZ BRACT,3 ; COUNT = COUNT -1 JMP NEBRK ; NOT ZERO *** PUNISH JMP NEXTC ; ALL IT WELL NECRT: LDA 2,.CART ; GIVE UNMATCHED <> ERROR JMP ER2X NESPB: LDA 2,.PAR1 ; GIVE NESTED () [] ERROR JMP ER2X NEPAR: LDA 2,.PARE ; GIVE UNMATCHED () ERROR& JMP ER2X NEBRK: LDA 2,.BKER ; GIVE BRACKET ERROR JMP ER2X ; END OF LINE PROCESSING ENDL: SKZ PARCT ; PARENS OK ?? JMP NEPAR ; NO GIVE ERROR SKZ BRACT ; BRACKETS OK ?? JMP NEBRK ; NO GIVE ERROR SKZ CARET ; ANGLE BRACKETS OK ?? JMP NECRT ; / NO REPORT ERROR JMP XPANT ; GO EXPAND <> ER2X: ER2 4 ; REPORT ERROR JMP @.CMDER ; BAG IT JMP @.CMDER ; DITTO .CMDER: CMDER .CART: CCART .PAR1: CPAR1 .PARE: CPARE .BKER: CBKER .CAR1: CCAR1 XPANT: LDA 0,NCARE,3 MOV 0,0,SNR ; ANY LEFT ? JMP FINISH ; NO ALL DONE XPAN2: LDA 0,CAPOS,3 ; GET POSITION FOR XPAND LDA 2,BUFR1,3 ; SWAP BUFFERS FOR COPY LDA 1,BUFR2,3 STA 1,BUFR1,3 STA 2,BUFR2,3 LDA 3,BFRPT,2 ; SET UP OUTPUT BUFFER STA 3,BFFFB,2 C XPAND ; XPAND THIS LEVEL JMP @.PRES0 ; TRY NEXT LE!VEL FINIS: LDA 2,BUFR1,3 ; AC2 => CURRENT BUFFER HEADER LDA 0,SBUFP ; AC0 => SCRATCH BUFFER HEADER SUB# 0,2,SZR ; IN CORRECT BUFFER ?? JMP XPAN2 ; NO- ONE MORE TIME MOV 0,2 ; YES- POINT AC2 AT SCRATCH BUFFER C CLBUF ; AND CLEAN UP SCRATCH BUFFER. ݲSKZ PARSW ; PARENS TO EXPAND? RTRN ; YES- TAKE EXPAND RETURN LDA 2,SSOSP,3 ; NO- RESTORE OLD STACK POINTER ISZ SSRTN,2 ; BUMP TO EXECUTE RETURN RTRN ; TAKE EXECUTE RETURN .PRES0: PRES0 EXPAR.SR5 t ; ; EXPAR- ; EXPAND PARENTHESIS IN COMMAND IN COMMAND BUFFER ; INTO DESTINATION BUFFER. ; ON ENTRY, AC0 = CURRENT SCAN POINTER IN DESTINATION BUFFER ; AC2 = POINTER TO DESTINATION BUFFER HEADER ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CEXPAR .RB CEXPAR.RB ** .ENDC J .TITL BEXPAR .RB BEXPAR.RB **[J] .NREL .ENT EXPAR ; ENTRY POINT .EXTN CALL RTRN ; LINK ROUTINES .EXTN PCBUF ; PUT CHARACTER INTO BUFFER .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN PUSHB ; PUSH BUFFER STATE .EXTN CLBUF ; INITIALIZE A BUFFER .EXTN CBUFR ; COMMAND BUFFER HEADER .EXTN SBUFR ; SCRATCH BUFFER HEADER ; DEFINE THE STACK BUFR= 1 ; DESTINATION BUFFER HEADER PBFA= BUFR+1 ; RUNNIɪNG POINTER INTO "FROM" BUFFER TXTSW= PBFA+1 ; TEXT MODE SWITCH PARSW= TXTSW+1 ; IN PARENTHESIS SWITCH COMSW= PARSW+1 ; COMMA SEEN SWITCH PAREX= COMSW+1 ; PARENTHISIS EXIST SWITCH STACK= PAREX ; STACK LENGTH ; ; SET UP DESTINATION BUFFER FOR PROCESSING EXPANSION ; STACK EXPAR: STA 0,PBFA,3 ; SAVE CURRENT BUFFER POINTER LDA 2,SSAC2,2 ; PICK UP DESTINATION BUFFER HEADER STA 2,BUFR,3 ; POINTER AND SAVE IN STACK. C GCBUF ; GET NEXT CHARACTER- LDA 0,EOTP ; IF IT IS NOT EOT SUB# 0,1,SZR ; THEN PUSH vBUFFER JMP EXPSH ; STATE ELSE LDA 0,BFRPT,2 ; RESET START OF STA 0,BFFFB,2 ; FRAME JMP EXINI ; AND GO INITIALIZE. EXPSH: LDA 1,PBFA,3 ; AC1 = CURRENT POSITION IN BUFFER C PUSHB ; PUSH BUFFER STATE ; ; INITIALIZE FOR EXPANSION ; EXINI: LDA 2,.SBUFR ; CLEAR AND INITIALIZE C CLBUF ; SCRATCH BUFFER LDA 2,.CBUFR ; AC2 => CBUFF HEADER LDA 0,BFRPT,2 ; SET RUNNING POINTER = STA 0,PBFA,3 ; START OF COMMAND LINE CLER TXTSW PARSW COMSW PAREX ; ; EXPAND PARENTHESIS FOR THIS COMMAND ; EXPND: LDA 2,.CBUFR ; AC2 => CBUFF HEADER LDA 0,PBFA,3 ; AC0 <= POINTER TO NEXT CHAR ISZ PBFA,3 ; BUMP POINTER C GCBUF ; GET NEXT CHARACTER DISP EXTBL ; AND DISPATCH ON IT. EXTBL: .+1 ; INPUT CHARACTER DISPATCH TABLE 42 ; QUOTE TEXTM ; FLIP TEXT MODE SWITCH SEMtbI ; SEMI-COLON ENDL ; FINISH THIS EXPANSION EOL ; CARRIAGE RETURN ENDL ; FINISH THIS EXPANSION .LPAR: "( ; LEFT PAREN LPAR ; ENTER PAREN EXPANSION MODE ") ; RIGHT PAREN RPAR ; EXIT PAREN EXPANSION MODE ", ; COMMA COMMA ; POSSIBLE END  AOF ARGUMENT -1 ; END OF TABLE ANYCH ; NON-SPECIAL PROCESSING ; STORE ANY CHARACTER IN APPROPRIATE BUFFER(S) ANYCH: LDA 0,PARSW,3 ; PICK UP PARENTHESIS SWITCH- MOVR 0,0,SNC ; IF WE ARE NOT INSIDE PARENS JMP NOPAR ; THEN STORE IN BOTH BUFFERS LDA 0,COMSW,3 ; ELSE CHECK COMMA SWITCH- MOV# 0,0,SZR ; IF WE HAVE FOUND A COMMA THEN JMP STSBF ; STORE CHARACTER JUST IN SBUFF. NOPAR: LDA 2,BUFR,3 ; AC2 => DESTINATION BUFFER HEADER C PCBUF ; STORE CHARACTER IN DESTINATION BUFFER MOV# 0,0,SZC ; INSIDE PARENS? JMP EXPND ; YES- GET NEXT CHARACTER STSBF: LDA 2,.SBUFR ; AC2 => SBUFF HEADER C PCBUF ; STORE CHARACTER IN SBUFF JMP EXPND ; AND GET NEXT CHARACTER ; HANDLE QUOTE TEXTM: LDA 0,TXTSW,3 ; PICK UP TEXT MODE SWITCH COM 0,0 ; FLIP IT STA 0,TXTSdW,3 ; AND PUT IT BACK JMP ANYCH ; GO STORE QUOTE ; HANDLE LEFT PARENTHESIS LPAR: C CHKTX ; IN TEXT MODE? JMP ANYCH ; YES- DON'T TREAT SPECIAL ISZ PARSW,3 ; NO- PUT US INTO PAREN MODE JMP EXPND ; GET NEXT CHARACTER ; HANDLE RIGHT PARENTHESIS RPAR:xr C CHKTX ; IN TEXT MODE? JMP ANYCH ; YES- DON'T TREAT SPECIAL LDA 0,COMSW,3 ; PICK UP COMMA SWITCH- MOV# 0,0,SNR ; IF NO COMMA SEEN JMP ENDEX ; THEN THIS EXPANSION IS DONE. LDA 2,.SBUFR ; AC2 => SBUFF HEADER C PCBUF ; STORE RPAR IN SBUFF ISZ PAREXL,3 ; AND SHOW THERE ARE STILL PARENS. ENDEX: CLER PARSW COMSW ; RESET PAREN MODE SWITCHES JMP EXPND ; AND GET NEXT CHARACTER .CBUFR: CBUFR .SBUFR: SBUFR EOTP: EOT ; HANDLE COMMA COMMA: C CHKTX ; IN TEXT MODE? JMP ANYCH ; YES- DON'T TREAT SPECIAL LDA 0,PARSW,3 ; PICK UP PAREN SWITCH MOV# 0,0,SNR ; ARE WE IN PAREN MODE? JMP ANYCH ; NO- DON'T TREAT SPECIAL LDA 0,COMSW,3 ; YES- PICK UP COMMA SWITCH MOV# 0,0,SZR ; HAS A COMMA BEEN SEEN YET? JMP STSBF ; YES- JUST STORE IN SBUFF ISZ COMSW,3 ; NO- SHyOW THAT WE'VE SEEN ONE LDA 1,.LPAR ; AND STORE A LEFT PAREN JMP STSBF ; IN SBUFF. ; HANDLE END OF LINE ENDL: LDA 2,.CBUFR ; AC2 => CBUFF HEADER LDA 0,BFRPT,2 ; RESET CBUFF STA 0,BFFFB,2 ; FOR NEXT LINE. LDA 2,BUFR,3 ; AC2 => DEST. BUFFER HEADER C P#CBUF ; STORE THE EOL IN DEST. BUFFER LDA 2,.SBUFR ; AC2 => SBUFF HEADER C PCBUF ; STORE THE EOL IN SBUFF LDA 0,PAREX,3 ; IF THERE ARE NO MORE MOV# 0,0,SNR ; PARENTHESIS TO EXPAND JMP ENDIT ; THAN JUST GO STORE EOT. ; MOVE NEXT PARENTHESIS LEVEL FROM SBUFF TO ; DESTINATION BUFFER CLER PBFA ; SET RUNNING POINTER = 0 MOVLV: LDA 0,PBFA,3 ; AC0 => NEXT CHARACTER TO MOVE ISZ PBFA,3 ; BUMP POINTER C GCBUF ; GET CHARACTER FROM SBUFF LDA 2,BUFR,3 ; AC2 => DESTINATION BUFFER HEADER C PCBUF ; STORE CHARACTER IN DESTINATION BUFFER LDA 2,.SBUFR ; AC2 => SBUFF HEADER DSZ BFFFB,2 ; DONE WITH SBUFF? JMP MOVLV ; NO- KEEP MOVING ENDIT: LDA 2,BUFR,3 ; AC2 => DESTINATION BUFFER HEADER LDA 1,EOTP ; AC1 <= EOT C PCBUF ; STORE EOT IN DESTINATION BUFFER RTRN ; AND THAT IS ALL !!!! ; CHECK IF IN TEXT MODE 0 CHKTX: LDA 0,TXTSW,2 ; PICK UP TEXT MODE SWITCH MOV# 0,0,SNR ; ARE WE IN TEXT MODE? ISZ SSRTN,2 ; NO- BUMP RETURN RTRN GETLI.SR5 p ; ; GETLI- ; EXPAND NEXT INPUT LINE INTO CBUFR ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CGETLI .RB CGETLI.RB ** .ENDC J .TITL BGETLI .RB BGETLI.RB **[J] .NREL .TXTM 1  ; PACK EM LEFT TO RIGHT .ENT GETLI ; ENTRY POINT .ENT GETMC ; EXECU RETURN FOR MACROS .ENT GTPSH ; EXECU RETURN FOR PUSH CLI .EXTN LINEX ; LINE EXPANSION OVERLAY NODE/NUMBER .EXTN CMDER ; CLI COMMAND ERROR ROUTINE .EXTN GCBUF ; GET CHARACTER FROM B *UFFER .EXTN PCBUF ; PUT CHARACTER IN BUFFER .EXTN POPB ; POP BUFFER STATE .EXTN EXECU ; EXECUTE THE COMMAND LINE .EXTN INSEF ; READ INSERT FILE INTO TBUFF .EXTN GETCR ; GET COMMAND RESULT .EXTN INSTX ; INSERT TEXT STRING INTO BUFFER .EXTN PRESCAN ;v SCAN PARENS AND EXPAND <> .EXTN EXPAR ; PAREN EXPANDER .EXTN MACEX ; MACRO EXPANDER .EXTN PCLI ; READ (F)CLI.CM INTO TBUFF .EXTN LDBI ; LOAD BYTE INCREMENT .EXTN CALL RTRN ; LINKING ROUTINES .EXTN TBUFR ; ADDRESS OF TBUFF FRAME .EXTN CBUFR ; ADDRESYS OF CBUFF FRAME ; DEFINE THE STACK CMRBP= 1 ; BYTE POINTER TO %COMMAND% RESULT CMRBF= CMRBP+1 ; AREA TO STORE %COMMAND% RESULT TBFA= CMRBF+7 ; RUNNING POINTER INTO TBUFF FRAME= TBFA ; FRAME SIZE FOR THIS ROUTINE FRAME GETLI: CLER TBFA ; INITIALIZPE INPUT POINTER GETLD: LDA 0,LINOV ; AC0 = LINE EXPAND OVERLAY NODE/NUMBER SUB 1,1 ; CONDITIONAL LOAD S OVLOD OVCH ; LOAD EXPANSION MODULES JMP LINER ; BAD NEWS !!!!! GETL1: LDA 0,TBFA,3 ; GET NEXT CHARACTER FROM TBUF LDA 2,.TBUFR C GCBUF ISZ TBFA,n3 ; BUMP POINTER DISP GETBL ; DISPATCH ON IT GETBL: .+1 ; INPUT CHARACTER DISPATCH TABLE "@ ; INSERT GETAT ; PUSH A LEVEL EOT ; END OF FILE GETET ; POP A LEVEL EOL ; END OF LINE GETEL ; PROCESS THE COMMAND SEMI ; END OF LINE GETEL ; PROCESS THE COMMAND LF ; LINE FEED GETL1 ; IGNORE IT "% ; EXECUTE COMMAND GETCM ; GET COMMAND RESULT 42 ; QUOTE (") GETXT ; PROCESS TEXT STRING -1 ; ANY OTHER CHARACTER GETAN ; JUST STORE IT GETAN: LDA 2,.CBUFR ; AC2 => CBUFF HEADER CQ PCBUF ; PUT CHARACTER INTO COMMAND BUFFER JMP GETL1 ; GET NEXT GETEL: LDA 2,.CBUFR ; AC2 => CBUFF HEADER C PCBUF ; STORE EOL C PRESCAN ; SCAN PARENS AND EXPAND <> JMP GETPR ; GO EXPAND PARENTHESIS C EXECU ; EXECUTE THE COMMAND LINE LDA 0,BFRPT,2 ; RESET CBUFR FOR NEXT LINE STA 0,BFFFB,2 JMP GETLD ; BUILD NEXT LINE GETAT: LDA 0,TBFA,3 ; AC0 => FILE NAME LDA 2,.TBUFR ; AC2 => TBUFF HEADER C INSEF ; OPEN AND READ THE LINE GETBK: LDA 0,BFRPT,2 ; AC0 = START OF NEW FRAME GETB1: STA 0,TBFA,3 ; SNET INPUT POINTER JMP GETL1 ; PROCESS THIS LEVEL GETET: LDA 2,.TBUFR ; AC2 => TBUFF HEADER LDA 0,BFRPT,2 ; AC0 <= START OF CURRENT FRAME MOV# 0,0,SNR ; IF = 0 RTRN ; THEN WE ARE DONE C POPB ; ELSE RESTORE PREVIOUS FRAME JMP GETB1 ; AND CONTINUE PRO^CESSING GETPR: LDA 0,TBFA,3 ; AC0 => NEXT CHARACTER IN TBUFF LDA 2,.TBUFR ; AC2 => TBUFF HEADER C EXPAR ; EXPAND PARENTHESIS JMP GETBK ; PROCESS THIS EXPANSION GETMC: LDA 0,TBFA,3 ; AC0 <= CURRENT INPUT POINTER LDA 2,.TBUFR ; AC2 => TBUFF HEADER C MACEX ; EXPAND MACRO JMP GETBK ; AND PROCESS EXPANSION GTPSH: LDA 0,TBFA,3 ; AC0 <= CURRENT INPUT POINTER C PCLI ; READ IN (F)CLI.CM JMP GETB1 ; AND GO PROCESS GETCM: BPT CMRBF CMRBP ; FORM => TO COMMAND RESULT BUFFER MOV 1,0 ; PUT IT IN AC0 LDA #1,TBFA,3 ; AC1 => COMMAND STRING LDA 2,.TBUFR ; AC2 => BUFFER C GETCR ; GET COMMAND RESULT TO CMRBF STA 1,TBFA,3 ; UPDATE INPUT POINTER LDA 2,.CBUFR ; MOVE RESULT TO CBUF GETCL: C LDBI ; PICK UP RESULT BYTE MOV# 1,1,SNR ; IS IT A NULL? JMP GETL1 ; ,sYES- JOIN INPUT LOOP C PCBUF ; NO- PUT BYTE IN CBUF JMP GETCL ; GO LOOK AT NEXT RESULT BYTE GETXT: LDA 0,TBFA,3 ; AC0 => TEXT STRING LDA 1,.TBUFR ; AC1 => "FROM" BUFFER LDA 2,.CBUFR ; AC2 => "TO" BUFFER C INSTX ; INSERT TEXT STRING INTO CBUF JMP G(nETB1 ; REJOIN PROCESSING LOOP LINER: ER2 ; REPORT OVERLAY LOAD ERROR JMP @.+1 ; GO BOMB CMDER ; OUT !!!! LINOV: LINEX .TBUFR: TBUFR .CBUFR: CBUFR BSPAS.SR5 P 'w ; ; PROGRAMS TO CONVERT UNSIGNED SINGLE ; PRECISON BINARY TO ASCII CHARACTER ; STRINGS ENDING WITH A NULL. ; AC0 IS OUTPUT STRING POINTER ; AC1 IS NUMBER. ; ON RETURN, AC0 IS UPDATED TO POINT TO NULL. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .31NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CBSPAS .RB CBSPAS.RB ** .ENDC J .TITL BBSPAS .RB BBSPAS.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT BSPAD BSPAO BSPAH .EXTN CALL LDBT STBT RTRN OP=1 DIGAD=OP+1 OSW=DI0[GAD+1 PEND=OSW ; BINARY TO ASCII DECIMAL ; LEADING ZEROS ARE SUPPRESSED. PEND BSPAD: STA 0,OP,3 ; SAVE BYTE POINTER LDA 0,DTABL ; DECIMAL TABLE ADDRESS JMP CNVRT ; JOIN COMMON ROUTIES ; BINARY TO ASCII OCTAL. ; LEADING ZEROS ARE SUPPRESSED. PENDR BSPAO: STA 0,OP,3 ; SAVE BYTE POINTER LDA 0,OTABL ; POINT TO OCTAL TABLE JMP CNVRT ; CONVERT IT ; BINARY TO ASCII HEX. ; LEADING ZEROS ARE SUPPRESSED. PEND BSPAH: STA 0,OP,3 ; SAVE OUTPUT POINTER LDA 0,HTABL ; HEX TABLE ADDRESS CNVRT: STA 0,DIGAD ,3 ; SAVE IN STACK MOV 1,2 ; AC2 <= INPUTTED NUMBER CLER OSW ; SHOW NO CHARS OUTPUTTED NEWDG: LDA @0,DIGAD,3 ; DECIMAL DIGIT VALUE SUB 1,1,SKP ; AC1 - DIGIT COUNTER NEWD1: INC 1,1 ; INC AT EACH DECREMENT SUBZ 0,2,SZC ; SURTRACT TILL NEGATIVE JMP NEW5D1 ; GO BACK ADD 0,2 ; ADD CUR VALUE BACK IN MOVZR 0,0 ; SAVE BIT 0 IN CARRY LDA 0,OSW,3 ; ZERO AND NO OUTPUT YET ADD# 0,1,SNR ; SKIP OUTPUT JMP NEWD2 LDA 0,OUTTB ; GET CHARACTER FROM OUTPUT TABLE ADD 1,0 C LDBT LDA 0,OP,3 ; OUTPUT POINTER C STB9T ; OUTPUT CHAR ISZ OSW,3 ; AN OUTPUT ISZ OP,3 ; UPDATE BYTE POINTER NEWD2: MOV# 0,0,SZC ; LAST LOOP ? JMP NEWD3 ; YES ISZ DIGAD,3 JMP NEWDG NEWD3: LDA 2,OSW,3 ; OUTPUT SW MOV# 2,2,SZR JMP NEWD4 LDA 0,OP,3 LDA 1,ZERO ; DO ATLEAST ONE ZERO C STBTՒ NEWD4: INC 0,0 ; DO FINAL NULL SUB 1,1 C STBT LDA 2,SSOSP,3 STA 0,SSAC0,2 ; STORE FINAL POINTER RTRN ZERO: "0 .RDX 16 ; HEX TABLE HTABL: .+1 1000 100 10 1 .RDX 10 DTABL: .+1 10000 1000 100 10 1 .RDX 8 OTABL: .+1 100000 10000 10050 100 10 1 OUTTB: .+1*2 .TXT *0123456789ABCDEF* GETCR.SR5 5 ; ; GETCR- ; GET COMMAND RESULT. ; EXECUTE COMMAND POINTED TO BY AC1 IN BUFFER POINTED TO ; BY AC2, AND STORE RESULT AT LOCATION POINTED TO BY AC0. ; ON RETURN, AC1 UPDATED TO POINT PAST %VARIABLE%. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .N'OMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CGETCR .RB CGETCR.RB ** .ENDC J .TITL BGETCR .RB BGETCR.RB **[J] .NREL .TXTM 1 ; PACK 'EM LEFT TO RIGHT .ENT GETCR ; ENTRY TO GET COMMAND RESULT .EXTN CALL RTRN ; LINK ROUTINES T.EXTN STBT ; STORE BYTE .EXTN COMP ; STRING COMPARE .EXTN MOVE ; MOVE CHARACTERS .EXTN WRBIN ; OUTPUT FORMAT ROUTINE .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN CMDER ; CLI COMMAND ERROR ROUTINE .EXTN LSTDR ; BYTE POINTER TO LAST DIRECTORY ; DEFINE THE STACK BUFR= 1 ; ADDRESS OF INPUT BUFFER FRAME INPUT= BUFR+1 ; INPUT POINTER OUTPT= INPUT+1 ; OUTPUT POINTER CNT= OUTPT+1 ; PLACE TO COUNT INPUT CHARS SCANNED WRKBP= CNT+1 ; WORKING BYTE POINTER CMNDP= WRKBP+1 ; BYTE POINTER TO COMMAND CMANDP= CMNDP+1 ; PLACE TO STORE COMMAND STACK= CMAND+6 ; STACK LENGTH STACK GETCR: STA 0,OUTPT,3 ; SAVE POINTER TO OUTPUT AREA STA 1,INPUT,3 ; SAVE POINTER TO INPUT STRING LDA 2,SSAC2,2 ; PICK UP INPUT BUFFER ADDRESS STA 2,BUFR,3 ; AND SAVE IT BPT CMAND CMNDP ; FORM BYTE POINTER TO COMMAND STORAGE STA 1,WRKBP,3 ; SAME FOR WORKING POINTER LDA 0,K14 ; SET MAX # INPUT COMMAND CHARS STA 0,CNT,3 ; TO BE 12 DECIMAL LDA 1,PRCNT ; STORE LEADING "%" JMP GETOK ; JOIN MOVE LOOP ; ; MOVE CHARACTERS FROM INPUTq BUFFER UNTIL: ; 1. AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED. ; 2. THE MAX # OF CHARS ALLOWED FOR A COMMAND HAVE BEEN MOVED. ; 3. THE COMMAND STRING IS SUCCESSFULLY TERMINATED UPON MOVING ; IN A TERMINATING "%". ; GETCL: LDA 0,INPUT,3 ; PICK UP INPUT STRING POINTER ISZ INPUT,3 ; BUMP POINTER TO NEXT BYTE LDA 2,BUFR,3 ; PICK UP ADDRESS OF BUFFER FRAME C GCBUF ; PUT NEXT BYTE IN AC1 DISP GETTB ; DISPATCH ON IT GETTB: .+1 ; INPUT CHARACTER DISPATCH TABLE PRCNT: "% ; COMMAND TERMINATOR G ETEC ; SUCCESSFUL END OF COMMAND EOL ; END OF LINE GETER ; ERROR SEMI ; END OF LINE GETER ; ERROR EOT ; END OF FILE GETER ; ERROR -1 ; ANYTHING ELSE GETOK ; STORE AS PART OF COMMAND GETOK: STORB WRKBP ; STORE THE BYTE DSZ CNT,3 ; HAS CHAR LIMIT BEEN REACHED? JMP GETCL ; NO- GET NEXT BYTE JMP GETR1 ; YES- ERROR K14: 14 ; ; END OF COMMAND FOUND- ; SEE IF COMMAND IS VALID IN THIS MODE. ; GETEC: STORB WRKBP ; STORE TERMINATING "%" SUB 1,1 ; STORE A NULL STORB WRKBP ; TO COMPLETE COMMAND STRING LDA 0,CMNDP,3 ; PUT BYTE => TO INPUTTED COMMAND IN AC0 LDA 2,COMTB ; LET AC2 INDEX COMMAND TABLE COMLP: LDA 1,0,2 ; AC1 GETS BYTE POINTER TO COMMAND INC 2,2 ; BUMP COMMAND TABLE POINTER COM# 1,1,SNR ; END OF TABLE? JMP CMERR ; YES- COMZMAND NOT VALID C COMP ; IS THIS THE INPUTTED COMMAND? JMP @0,2 ; YES- GO EXECUTE IT INC 2,2 ; NO- BUMP COMMAND TABLE POINTER JMP COMLP ; CHECK NEXT TABLE ENTRY COMTB: .+1 ; VALID COMMAND TABLE TGDIR*2 ; GET CURRENT DIRECTORY GDIR TGCIN*2 ; GA,ET INPUT CONSOLE NAME GCIN TGCOUT*2 ; GET OUTPUT CONSOLE NAME GCOUT TLDIR*2 ; GET LAST (PREVIOUS) DIRECTORY LDIR TMDIR*2 ; GET MASTER DEVICE MDIR TGDATE*2 ; GET TODAY'S DATE GDATE TTIME*2 ; GET THE TIME GTIME TFGND*2 ; GET GROUND (BAC3_K/FORE) FGND TGSYS*2 ; GET SYSTEM NAME GSYS -1 ; END OF VALID COMMAND TABLE ** .NOLOC 1 TGDIR: .TXT *%GDIR%* TMDIR: .TXT *%MDIR%* TGCIN: .TXT *%GCIN%* TGCOUT: .TXT *%GCOUT%* TFGND: .TXT *%FGND%* TLDIR: .TXT *%LDIR%* TGDATE: .TXT *%DATE%* TTIME: .TIXT *%TIME%* TGSYS: .TXT *%GSYS%* ** .NOLOC 0 ; ERROR HANDLING GETER: STORB WRKBP ; STORE THE BAD CHARACTER GETR1: SUB 1,1 ; STORE A TERMINATING NULL STORB WRKBP ; AT END OF STRING CMERR: LDA 2,.CIVAR ; UNMATCHED "%" OR INVALID COMMAND LDA 0,CMNDP,3 ;ـ AC0 GETS POINTER TO BAD COMMAND ER1 ; REPORT ERROR JMP @.+1 ; GO BOMB CMDER ; OUT !!!!! .CIVAR: CIVAR ; ; EXECUTE COMMANDS AND STORE RESULTING TEXT ; AT LOCATION POINTED TO BY BY OUTPT. ; GDIR: LDA 0,OUTPT,3 ; SET POINTER TO RESULT BUFFE؎R S GDIR ; GET CURRENT DIRECTORY NOP JMP GETEX ; GO EXIT GCIN: LDA 0,OUTPT,3 ; SET POINTER TO RESULT BUFFER S GCIN ; GET INPUT CONSOLE NAME NOP JMP GETEX ; GO EXIT GCOUT: LDA 0,OUTPT,3 ; SET POINTER TO RESULT BUFFER S GCOUT ; GET OUTPUT CONSOLE NAME NOP JMP GETEX ; GO EXIT LDIR: LDA 0,.LSTDR ; AC0 => LAST (PREVIOUS) DIRECTORY LDA 1,OUTPT,3 ; AC1 => RESULT BUFFER C MOVE ; MOVE IN LAST DIRECTORY NAME JMP GETEX ; GO EXIT MDIR: LDA 0,OUTPT,3 ; SET POINTER TO RESULT BUFFER S MDIR ; GET MASTER DEVICE NOP JMP GETEX ; GO EXIT GSYS: LDA 0,OUTPT,3 ; SET POINTER TO RESULT BUFFER S GSYS ; GET SYSTEM NAME NOP MOVZR 0,2 ; FORM WORD POINTER TO NAME SUB 0,0 ; NULL STA 0,UFTEX,2 ; WIPE OUT EXTENSION JMP GETEX ; GO EXIT GDATE: S GDAY ; GET TtODAY'S DATE NOP STA 0,BUFR,3 ; SAVE DAY IN STACK STA 1,CNT,3 ; SAVE MONTH IN STACK LDA 1,K68 ; ADJUST YEAR FOR ADD 1,2 ; 1968 BASE LDA 0,DAYMP ; AC0 => OUTPUT FORMAT TEXT JMP FRMAT ; GO FORMAT AND OUTPUT GTIME: S GTOD ; GET THE TIME NOP STA 2,Cu NT,3 ; SAVE HOURS IN THE STACK STA 1,BUFR,3 ; SAVE MINUTES IN THE STACK MOV 0,2 ; AC2 <= SECONDS LDA 0,TIMSP ; AC0 => OUTPUT FORMAT TEXT FRMAT: LDA 1,OUTPT,3 ; SET POINTER TO RESULT BUFFER C WRBIN ; FORMAT OUTPUT INTO RESULT BUFFER CNT ; MONTH/HOURS BUFR ; DAY/MINUTES SSAC2 ; YEAR/SECONDS JMP GETEX ; GO EXIT FGND: LDA 2,USTP ; AC2 => UST LDA 2,USTPC,2 ; WHAT GROUND ARE WE IN? MOV# 2,2,SZR ; IF WE ARE IN FOREGROUND LDA 2,KFNUL ; STORE AN "F" + NULL ELSE MOVS 2,1 ; JUST STORE TWO NULLS FORvT BACKGROUND. STORB OUTPT ; STORE FIRST BYTE MOVS 1,1 ; PUT LAST BYTE INTO POSITION STORB OUTPT ; AND STORE IT GETEX: LDA 2,SSOSP,3 ; AC2 GETS CALLER'S STACK POINTER LDA 1,INPUT,3 ; PICK UP UPDATED INPUT BYTE POINTER STA 1,SSAC1,2 ; RETURN IT TO CALLER RTRN ; THAT'S ALL, FOLKS !!!! KFNUL: .TXT *F* .LSTDR: LSTDR K68: 68. ** .NOLOC 1 DAYMP: .+1*2 .TXT *^D^Z<2>-^D^Z<2>-^D^Z<2>* TIMSP: .+1*2 .TXT *^D^Z<2>:^D^Z<2>:^D^Z<2>* ** .NOLOC 0 ERROR.SRoo0>.LCNS ;COPYRIGHT (C) DATA GENERAL CORPORATION,1972,1973,1974,1975,1977 ;ALL RIGHTS RESERVED ;LICENSED MATERIAL-PROPERTY OF DATA GENERAL CORPORATION ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CC?OND==1 .TITL CERROR .RB CERROR.RB ** .ENDC J .TITL BERROR .RB BERROR.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT HIGHER= CCMAX ; HIGHEST ERROR CODE IN FILE .MACRO ERR ** I=^1 ** .DO I>=400 ** I=I+40 ** .ENDC ** .LOC I ** C\I+C\I ** .NREL C\0I: .TXT% ** .DO HIGHER>=400 .BLK HIGHER-377 ** .ENDC ** .NOLOC 1 ERR ERFNO *ILLEGAL CHANNEL NUMBER* ERR ERFNM *ILLEGAL FILE NAME* ERR ERICM *ILLEGAL SYSTEM COMMAND* ERR ERICD *ILLEGAL COMMAND FOR DEVICE* ERR ERSV1 *NOT A SAVE FILE* ERR ERWR0  *ATTEMPT TO WRITE AN EXISTENT FILE* ERR EREOF *END OF FILE* ERR ERRPR *FILE READ PROTECTED* ERR ERWPR *FILE WRITE PROTECTED* ERR ERCRE *FILE ALREADY EXISTS* ERR ERDLE *FILE DOES NOT EXIST* ERR ERDE1 *PERMANENT FILE* ERR ERCHA *FILE ATTRIBUTEMg PROTECTED* ERR ERFOP *FILE NOT OPEN* ERR ERFUE *FATAL UTILITY ERROR* ERR ERUFT *CHANNEL ALREADY IN USE* ERR ERLLI *LINE TOO LONG* ERR ERRTN *ATTEMPT TO RESTORE A NON-EXISTENT IMAGE* ERR ERPAR *PARITY ERROR* ERR ERCM3 *PUSH DEPTH EXCEEDED* E5RR ERMEM *INSUFFICIENT MEMORY TO EXECUTE PROGRAM* ERR ERSPC *FILE SPACE EXHAUSTED* ERR ERFIL *FILE DATA ERROR* ERR ERSEL *UNIT IMPROPERLY SELECTED* ERR ERADR *NO STARTING ADDRESS* ERR ERRD *ATTEMPT TO READ INTO SYSTEM SPACE* ERR ERDIO *DIRECT I/O ACCESS ONLY* ERR ERDIR *FILES MUST EXIST IN THE SAME DIRECTORY* ERR ERDNM *DEVICE NOT IN SYSTEM* ERR EROVN *ILLEGAL OVERLAY NUMBER* ERR EROVA *NO DIRECT I/O* ERR ERTIM *INVALID TIME OR DATE* ERR ERNOT *OUT OF TCB'S* ERR ERXMT *SIGNAL TO BUSY ADDRESS* ERR ERSQF *SQUASH FILE ERROR* ERR ERIBS *DEVICE ALREADY IN SYSTEM* ERR ERICB *INSUFFICIENT CONTIGUOUS BLOCKS* ERR ERSIM *DUPLICATE READ OR DUPLICATE WRITE* ERR ERQTS *ERROR IN USER TASK QUEUE TABLE* ERR ERNMD *NO MORE DCB'S* ERR ERIDS *ILLEGAL DIRECTORY NAME* ERR ERDSN *NO SUCH DIRECTORY* ERR ERD2S *DIRECTORY SIZE INSUFFICIENT* ERR ERDDE *DIRECTORY DEPTH EXCEEDED* ERR ERDIU *DIRECTORY IN USE* ERR ERLDE *LINK DEPTH EXCEEDED* ERR ERFIU *FILE IN USE* ERR ERTID *TASK ID ERROR* ERR ERCMS  *COMMON SIZE ERROR* ERR ERCUS *COMMON USAGE ERROR* ERR ERSCP *FILE POSITION ERROR* ERR ERDCH *INSUFFICIENT ROOM IN DATA CHANNEL MAP* ERR ERDNI *DIRECTORY NOT INITIALIZED* ERR ERNDD *NO DEFAULT DEVICE* ERR ERFGE *FOREGROUND AL^UREADY RUNNING* ERR ERMPT *ILLEGAL PARTITION VALUE* ERR EROPD *DIRECTORY SHARED* ERR ERUSZ *NO ROOM FOR UFTS* ERR ERMPR *ADDRESS ERROR IN .SYST ARGUMENT* ERR ERNLE *NOT A LINK ENTRY* ERR ERNTE *CANNOT CHECKPOINT CURRENT BG* ERR ERSDE *SYS.DR E RROR*  ERR ERMDE *MAP.DR ERROR* ERR ERDTO *DEVICE TIMEOUT* ERR ERENA *LINK ACCESS NOT ALLOWED* ERR ERMCA *MCA REQUEST OUTSTANDING* ERR ERSRR *TRANSMISSION TERMINATED BY RECEIVER* ERR ERSDL *SYSTEM DEADLOCK* ERR ERCLO *CHANNEL CLOSED BY ANOTHER? TASK* ERR ERSFA *SPOOL FILES ACTIVE* ERR ERABT *TASK NOT FOUND FOR ABORT* ERR ERDOP *DEVICE PREVIOUSLY OPENED* ERR EROVF *SYSTEM STACK OVERFLOW* ERR ERNMC *NO MCA RECEIVE REQUEST OUTSTANDING* ERR ERNIR *ATTEMPT TO RELEASE AN OPEN DEVICE* ERR |ERXMZ *A ZERO .XMT OR .IXMT MESSAGE* ERR ERCANT *YOU CAN'T DO THAT* ERR ERQOV *TOVLD NOT LOADED FOR QUEUED OVERLAY TASKS* ERR EROPM *OPERATOR MESSAGES NOT SYSGENED* ERR ERFMT *DISK FORMAT ERROR* ERR ERBAD *INVALID BAD BLOCK TABLE* ERR ERBSPC *dINSUFFICIENT SPACE IN BAD BLOCK POOL (CORE)* ERR ERZCB *ATTEMPT TO CREATE A ZERO LENGTH CONTIGUOUS FILE* ERR ERNSE *PROGRAM NOT SWAPPABLE* ERR ERBLT *BLANK TAPE* ERR ERRDY *ALM LINE NOT READY* ERR ERINT *CONSOLE INTERRUPT RECEIVED* ERR EROVR *READ OVERRUN ERROR* ERR ERFRM *READ FRAMING ERROR* ERR ERSPT *TOO MANY SOFT ERRORS* ERR CNEAR *NOT ENOUGH ARGUMENTS* ERR CILAT *ILLEGAL ATTRIBUTE* ERR CNDBD *NO DEBUG ADDRESS* ERR CCLTL *COMMAND LINE TOO LONG* ERR CNSAD *NO STARTING ADDRESS* IERR CCKER *CHECKSUM ERROR* ERR CNSFS *NO SOURCE FILE SPECIFIED* ERR CNACM *NOT A COMMAND* ERR CILBK *ILLEGAL BLOCK TYPE* ERR CSPER *NO FILES MATCH SPECIFIER* ERR CPHER *PHASE ERROR* ERR CTMAR *TOO MANY ARGUMENTS* ERR CTMAD *TOO MANY ACTIVE Dy&EVICES* ERR CILNA *ILLEGAL NUMERIC ARGUMENT* ERR CSFUE *FATAL SYSTEM UTILITY ERROR* ERR CILAR *ILLEGAL ARGUMENT* ERR CCANT *YOU CAN'T DO THAT* ERR CTMLI *TOO MANY LEVELS OF INDIRECT* ERR CSYER *SYNTAX ERROR INSIDE []* ERR CBKER *SYNTAX ERROR: UNMATCHED OR NESTED []* ERR CPARE *SYNTAX ERROR: UNMATCHED OR NESTED ( )* ERR CCART *SYNTAX ERROR: "<74>" WITHOUT "<76>" OR "<76>" WITHOUT "<74>"* ERR CCAR1 *SYNTAX ERROR: ILLEGAL NESTING OF <74> <76> AND ( )* ERR CINDE *ILLEGAL INDIRECT FILGE NAME* ERR CPAR1 *SYNTAX ERROR: ILLEGAL NESTING OF () AND []* ERR CIVAR *ILLEGAL VARIABLE* ERR CILTA *ILLEGAL TEXT ARGUMENT* ERR CTATL *TEXT ARGUMENT TOO LONG* ** .NOLOC 0 .END HIGHER MOV2.SR5 k2 ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMOV2 .RB CMOV2.RB ** .ENDC J .TITL BMOV2 .RB BMOV2.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENTO MOV2E .ENT MOV2 w.EXTN GETAR ; GET ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN SETSW ; SET SWITCH ROUTINE .EXTN BFMVO ; BUFFER MOVE LINE OUT .EXTN SBUFR ; SCRATCH BUFFER .EXTN COMP ; COMPARE STRINGS .EXTN LDBT .EXTN STBI .EXTN CALL RTRN RCALL .EXTN WRLCH WRBIN ** .DO BCOND .EXTN WRLIN ** .ENDC .EXTN CMOVE MOVE .EXTN .ASCD ; ASCII TO DECIMAL CONVERSION .EXTN .INDEX ; DEFINE THE STACK INSW= 1 ; DIRECTORY INIT SWITCH ASW= INSW+1 ; ALL SWITCH DSW= ASW+1 ; DELETE ORIGIONAL SWITCH KSW= DSW+1 ; NO LINK SWITCH RSWW= KSW+1 ; REPLACE SWITCH VERIF= RSW+1 ; VERIFY FLAG ODIRP= VERIF+1 ; POINTER TO ODIR ODIR= ODIRP+1 ; OUTPUT DIRECTORY NAME ONAMP= ODIR+40 ; OUTPUT FILE NAME POINTER INAME= ONAMP+1 ; INPUT FILE NAME INAMP= INAME+30; POINTER TO INAME CP= INAMP+1 ; ARGf POINTER STAIP= CP+1 ; POINTER TO STATI STAOP= STAIP+1 ; POINTER TO STATO STATI= STAOP+1 ; INPUT FILE STATS AREA STATO= STATI+CFSIZ+SCDBS ; OUTPUT FILE STATS AREA STACK= STATO+CFSIZ ; STACK SIZE ICH= COMCH LCH= CH1 ** .DO CCOND==1 SOCH= COUT OCH= PUSCH ** .ENDC J SOCH= SOUT OCH= TMPCH **[J] STACK MOV2: ISZ SSRTN,2 ; SET GOOD RETURN C GETSW ; GET THE SWITCHES STA 0,CP,3 ; SAVE POINTER SW A D K R ; TEST SWITCHES SETVR VERIF ; SET UP VERIFY IF ANY BPT ODIR ODIRP ; SET POINTER TO OUTPUT DIR'ECTORY BPT INAME INAMP ; SET POINTER TO INPUT NAME AREA LDA 0,CP,3 C GETAR ; GET OUTPUT DIRECTORY NAME NOP ; WE KNOW ITS THERE STA 0,INSW,3 ; SET INIT SWITCH SUB 1,1 S INIT ; INIT IT JMP @MINEP ; AN ERROR FIND OUT WHAT TYPE MOVE0: LDA 1,ODIRP,13 ; MOVE NAME TO A SAFE PLACE C MOVE MOV 1,0 ; PUT A COLN AFTER IT LDA 1,CCOL C STBI STA 0,ONAMP,3 ; SAVE POINTER TO NAME LDA 2,.SBUFR ; SET UP ARG POINTER LDA 0,BFRPT,2 STA 0,CP,3 LDA 2,STAOD ; BUILD POINTERS TO STATS AREAS ADD 3,2 STA 2,STAOP,3 LDA 0,OUTCH ; PUT IN CHANNEL NUMBER STA 0,ICHAN,2 LDA 2,STAID ADD 3,2 STA 2,STAIP,3 LDA 0,INCH STA 0,ICHAN,2 JMP MOVE1 STAID: STATI STAOD: STATO INCH: ICH OUTCH: OCH CCOL: ": MINEP: MINER .SBUFR: SBUFR PERAT: ATPER DIRPAR: ATDIR+ATPAR LINAT: ATLNK C40: 40 MOVFI: MOVFN .MFIER: MFIER MOVE1: LDA 3,USP ; RESTORE USP LDA 0,CP,3 ; RESTORE CP LDA 1,INAMP,3 LDA 2,.SBUFR C GARBU ; GET NEXT ARGUMENT JMP @MOVFI ; ALL DONE STA 0,CP,3 ; SAVE POINTER TO NEXT ARG MOV 1,0 LDA 1,STAIP,3 ; GET STATS OTN FILE S STAT JMP @.MFIER ; HAS TO BE THERE MOV 1,2 LDA 1,C40 C .INDEX ; TEST FOR /S JMP MOVEN ; NO NORMAL CASE MOV 1,0 ; YES WIPE OUT SPACE SUB 1,1 C STBI MOVEN: LDA 1,ONAMP,3 ; MOVE OUTPUT FILE NAME TO SAFE PLACE C MOVE LDA 0,UFTAT,2 ; AC40 = ATTRIBUTES LDA 1,DIRPAR AND# 1,0,SZR ; DIR OR PART ? JMP MOVE1 ; YES NOT ALLOWED HERE SKZ ASW ; ALL ? JMP MOVEA ; YES - ON WITH IT LDA 1,PERAT AND# 0,1,SZR ; PERMANENT ?? JMP MOVE1 ; YES - SKIP IT MOVEA: SNZ KSW ; LINKS ALLOWED ? JMP M3OVEB ; YES - DON'T BOTHER CHECKING LDA 1,LINAT AND# 1,0,SZR ; NO - THIS A LINK ?? JMP MOVE1 ; YEP FORGET HIM MOVEB: LDA 0,ODIRP,3 ; GET STATS ON OUTPUT FILE LDA 1,STAOP,3 S STAT JMP MOVE2 ; NOT THERE GOOD SNZ RSW ; ALREADY EXISTS - TEST FOR 4M/R SWITCH JMP MFAER ; NO GIVE ERROR LDA 3,STAOP,3 ; GET POINTER TO OUTPUT FILE STATS LDA 0,UFTAT,2 LDA 1,LINAT AND# 0,1,SZR ; FROM FILE A LINK ?? JMP MOVE1 ; YES LINKS ARE ALWAYS OLDER LDA 0,UFTAT,3 AND# 0,1,SZR ; DESTINATION FILE A LINK ?? JMP MOVE1 ; YES CAN'T COMPARE TIME SO LEAVE IT ALONE LDA 0,UFTYD,2 LDA 1,UFTYD,3 SUBZ# 0,1,SNC ; DESTINATION FILE OLDER ?? JMP MODEL ; YES GET RID OF IT SUBZ# 0,1,SZR ; SAME ?? JMP MOVE1 ; NO - FORGET IT LDA 0,UFTHM,2 ; YES DOWN TO THE MINUTES FLDA 1,UFTHM,3 SUBZ# 0,1,SZC ; DESTINATION OLDER ?? JMP MOVE1 ; NO LEAVE ALONE MODEL: LDA 3,USP ; YES DELETE IT LDA 0,ODIRP,3 S DELE JMP MNFER ; GOOD GRIEF MOVE2: LDA 2,STAIP,3 ; CREATE NEW ONE C CREAT JMP MNFER ; CAN'T HAPPEN LDA 1,UFTAT,2 LDA 2,LINAT AND 2,1,SZR ; A LINK ? JMP MOVE3 ; YEP ALL DONE LDA 1,STAOP,3 ; GET STATS ON OUTPUT FILE S STAT JMP MNFER C OPEN STATO ; OPEN OUTPUT FILE JMP MNFER ; WELL LDA 0,INAMP,3 C OPEN STATI ; OPEN INPUT FILE JMP MNFER C COPY STATI STATO ; COP؏Y THE FILE JMP MFRTN LDA 2,STAIP,3 ; COPY ATTRIBUTES LDA 3,STAOP,3 LDA 0,UFTAT,2 STA 0,UFTAT,3 LDA 0,UFTLK,2 STA 0,UFTLK,3 C CLOS STATO ; CLOSE OUTPUT FILE AND CHANGE ATTRIBUTES JMP MOFER C CLOS STATI ; CLOSE INPUT FILE JMP MIFER MOVE3: SNZ DSW  ; DELETE ORIGIONAL ?? JMP MOVE4 ; NO - CONTINUE LDA 0,INAMP,3 LDA 2,STAIP,3 LDA 1,UFTAT,2 LDA 2,LINAT AND# 2,1,SNR ; A LINK ??  JMP MOVDE ; NO DELETE IT S ULNK ; YES UNLINK IT JMP MNFER JMP MOVE4 MOVDE: S DELE JMP MNFER MOVE4: SNZ VERIF JMP @MOV1P ; NO GET NEXT FILE LDA 0,MVERM ; VERIFY MESSAGE LDA 2,ONAMP,3 ; FILE NAME WRVER VERIF SSAC2 ; OUTPUT IT JMP @MOV1P MFAER: LDA 3,USP ; RESTORE STACK POINTER LDA 2,.ERCRE ; FILE ALREADY EXISTS ERROR MOFER: LDA 0,ODIRP,3 ; PICK UP OUTPUT FIL\E NAME JMP MNFER ; GIVE NON FATAL ERRROR MIFER: LDA 0,INAMP,3 ; PICK UP INPUT FILE NAME JMP MNFER MFIER: LDA 1,.ERDLE SUB# 1,2,SZR ; FILE DOES NOT EXIST ? JMP MFRTN ; NO BAG IT MNFER: ER1 4 JMP MOVRS ; RESET AND CONTINUE WITH NEXT ARG JMP FERTN ;< THE FOOL WANTS IT FATAL MFRTN: ER1 3 NOP FERTN: MOVO 0,0 ; SET FATAL INDICATOR JMP MOCLS ; CLOSE ALL FILES FERT1: LDA 3,SSOSP,3 ; TAKE ERROR RETURN DSZ SSRTN,3 MOVEX: LDA 3,USP ; RESTORE USP LDA 2,VERIF,3 ; VERIFY CHANNEL # MOVZR# 2,2,SNR ; LINE PRINTER OPEN ? RTRN ; NO- JUST RETURN S CLOS CPU ; YES- CLOSE IT NOP RTRN ; BYE BYE !!! MOVRS: MOVZ 0,0 ; SET NON FATAL FLAG MOCLS: S CLOS ICH ; CLOSE INPUT CHANNEL NOP S CLOS OCH ; CLOSE OUTPUT CHANNEL JMP MOCL1 ; IT WASN'T OPEN CONTINUE LDA 0,ODIRP,3 ; IT WAS OPEN DELETE OUTPUT FILE S DELE NOP MOCL1: MOV 0,0,SNC ; FATAL ? JMP @MOV1P ; NO CONTINUE WITH NEXT ARG LDA 0,INSW,3 ; YES RELEASE DIRECTORY IF NECESSARY MOV 0,0,SNR ; WAS IT IN SYSTEM ? JMP FERT1 ; YES LEAVE IT ALONE S RLSE ; 4 NO TAKE IT OUT NOP ; WHO CARES JMP FERT1 MINER: LDA 1,.ERIBS ; DEVICE ALREADY IN SYSTEM ?  SUB# 1,2,SZR JMP MFRTN ; NO BAG IT SUB 2,2 STA 2,INSW,3 ; YES REMEMBER IT JMP @MOV0P ; AND CONTINUE MOVFN: LDA 0,INSW,3 ; DIRECTORY INITED SWITCH Q SNEZ 0 ; WAS DIRECTORY INITED WHEN WE GOT HERE ? JMP MOVEX ; YES- JUST CLOSE VERIFY & RETURN S RLSE ; NO- RELEASE IT FIRST JMP MFRTN JMP MOVEX ; THEN EXIT. .ERCRE: ERCRE .ERIBS: ERIBS .ERDLE: ERDLE MOV0P: MOVE0 MOV1P: MOVE1 MVERM: .+1*2 ** .NOLOCi8 1 .TXT *^C<15>* ** .NOLOC 0 0 GARBU: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS C BFMVO ; MOVE ARG TO USER SPACE LDA 2,SSOSP,3 ; RESTORE STACK POINTER STA 0,SSAC0,2 ; RETURN POINTER TO CALLER LDA 0,SSAC1,2 ; GET FIRST BYTE OF ARG C LDBT LDA 0,C200 SUBo# 0,1,SZR ; END OF FILE ?? ISZ SSRTN,2 ; NO GIVE NORMAL RETURN RTRN C200: 200 ; END OF FILE INDICATOR ; DEFINE THE STACK CHANT= 1 ; CHANNEL TABLE ADDRESS CHAN= CHANT+1 ; PHYSICAL CHANNEL NUMBER TMP= CHAN+1 ; TEMP FOR ALL KINDS OF THINGS TMP0= !2TMP+1 ; COPY OF CALLERS AC0 TMP1= TMP0+1 ; COPY OF CALLERS AC1 STACK= TMP1 ; STACK LENGTH 0 EFSYS: LDA 3,SSOSP,2 ; PICK UP OLD STACK POINTER LDA 0,@SSRTN,3 ; GET "CHANNEL NUMBER" ISZ SSRTN,3 ; SET GOOD RETURN ISZ SSRTN,3 LDA 1,SSAC0,3 ; COPY AC0 A> ; THIS ROUTINE CREATES A FILE,LINK,DIRECTORY OR PARTITION ; ACCORDING TO THE UFT ENTRY POINTED TO BY AC2 ; ; CALLING SEQUENCE ; LDA 0,(FILENAME) ; LDA 2,(POINTER TO STATS) ; CALL ; CREATE ; (ERROR RETURN) ; AC2 = ERROR CODE ; (NORMAL RETURN) ; ; ;Գ DEFINE THE STACK TMP= 1 ; TEMP FOR ALL KINDS OF THINGS NAME= TMP+1 ; ADDRESS OF FILE NAME LNAM= NAME+1 ; AREA FOR LINK NAME LNAMP= LNAM+20 ; POINTER TO LNAM STACK= LNAMP ; STACK SIZE STACK CREATE: ISZ SSRTN,2 ; ASSUME GOOD RETURN STA 0,NAME,3 LvDA 2,SSAC2,2 ; GET POINTER TO STATS LDA 0,UFTAT,2 ; GET ATTRIBUTES LDA 1,CRTBL ; DISPATCH TO PROPER ROUTINE STA 1,TMP,3 CREA1: LDA 1,@TMP,3 ; GET A MASK ISZ TMP,3 COM# 1,1,SZR ; END OF TABLE AND# 1,0,SZR ; OR MATCH ? JMP CREA2 ; YES GO TO IT ISZ TMP,3 ; NO BUMP TO NEXT ENTRY JMP CREA1 ; GO TO IT CREA2: LDA 1,@TMP,3 ; GET ROUTINE ADDRESS STA 1,TMP,3 ; MAKE IT ACCESSABLE JMP @TMP,3 ; GO TO IT CRTBL: .+1 ATLNK ; LINK CRLNK ATPAR ; PARTITION CRPAR ATDIR ; DIRECTORY CRDIR ATRAN ; RANDOM CRRAN .ATCON: ATCON CRCON -1 CRSEQ ; CREATE A LINK ENTRY CRLNK: BPT LNAM LNAMP ; MAKE POINTER TO BUILD ALIS NAME LDA 0,UFLAD,2 MOV 0,0,SNR ; ALTERNATE DIRECTORY ? JMP CRLI1 ; NO TRY FOR ALIAS NAME MOV 1,0 ; WHERE TO PUT IT MOV 2,1 ; SAVE AC2 LDA 3,UFLDP ; WHERE TO GET IT ADD 3,2 C SNTUN ; CONVERT TO USER NAME MOV 1,2 LDA 1,CRPER ; LOOK FOR . C .INDEX NOP MOV 1,0 LDA 1,CCOLN ; PUT A COLN AFTER IT C STBI MOV 0,1 CRLI1: MOV 1,0 LDA 3,UFLNP ; POINT TO ALIAS NAME ADD 3,2 C SNTUN `; CONVERT TO USER FORMAT NAME LDA 1,LNAMP,3 ; POINT TO WHAT WE JUST BUILT LDA 0,NAME,3 ; CREATE THE LINK S LINK JMP CRERR ; SORRY BOUT THAT RTRN UFLDP: UFLAD UFLNP: UFLAN CRPER: ". ; CREATE A RANDOM FILE CRRAN: C CKNAM ; TEST NAME AND TIME BLOCK  JMP CRRA1 ; NO TIME BLOCK DO REGULAR CREATE S TCRND ; HAS A TIME BLOCK DO MAGIC CREATE JMP CRERR RTRN CRRA1: S CRAN JMP CRERR RTRN ; CREATE A CONTIGUOUS FILE CRCON: C CKNAM ; TEST FOR TIME BLOCK JMP CRCO1 ; NO TIME BLOCK DO REGULAR CREATE S TCCON ; HAD A TIME BLOCK - MAGIC JMP CRERR RTRN CRCO1: S CCON JMP CRERR RTRN ; CREATE A SEQUENTIAL FILE CRSEQ: C CKNAM ; TEST FOR TIME BLOCK ETC JMP CRSE1 ; NO TIME BLOCK DO REGULAR CREATE S TCREA JMP CRERR RTRN CRSE1: S CREA ; PLAIN OL CREATE JMP CRERR RTRN ; CREATE A PARTITION CRPAR: C CKNAM ; DO SETUP STUFF NOP ; NO SUCH THING AS A TRANSPARANT CPAR S CPAR JMP CRERR ; GOOD GRIEF RTRN ; CREATE A DIRECTORY CRDIR: C CKNAM ; SETUP NOP S CDIR JMP CRERR RTRN ; SETUP ROUTINEf 0 CKNAM: MOV 2,3 ; SSOSP BECOMES CSP LDA 2,SSAC2,2 ; GET STATS POINTER LDA 1,UFTYD,2 ; GET FIRST WORD OF TIME BLOCK MOV 1,1,SZR ; ANY TIME ? ISZ SSRTN,3 ; YES BUMP RETURN LDA 1,.UFAC ; RETURN POINTER TO TIME BLOCK ADD 2,1 STA 1,SSAC2,3 LDA 1,.ATCON AND# 1,0,SNR ; CONTIG ? JMP CKNA1 ; NO JUST GET NAME LDA 1,UFTBK,2 ; YES BLOCK LENGTH TO AC1 INC 1,1 STA 1,SSAC1,3 CKNA1: LDA 0,NAME,3 ; NAME TO AC0 STA 0,SSAC0,3 RTRN ; GO TO IT CRERR: LDA 3,SSOSP,3 ; RETURN ERROR CODE STA 2,SSAC2,3 DS#Z SSRTN,3 RTRN .UFAC: UFTAC CCOLN: ": ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTEN\SION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX CALL WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX}: .+1*2 .TXT /^C.^W/ FSERR.SR5 7/ ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CFSERR .RB CFSERR.RB ** .ENDC J .TITL BFSERR .RB BFSERR.RB **[J] .NREL .TXTM 1 ; PACK 'EM LEFT TO RIGHT ; ; FSERR- ; RETRIEVE ERROR TEXT FROM ERROR FILE ; ON ENTRY, AC0 <= ERROR CODE ; AC1 => WHERE TO PUT TEXT ; C FSERR ; ; ON RETURN, AC1 => END OF ERROR TEXT STRING ; .ENT FSERR ; RETRIEVE ERROR TEXT FROM ERROR FILE .EXTN RTRN,CALL ; LINKING ROUTINES .EXTN MOVE ; CHARACTER MOVER .EXTN BSPAO ; BINARY TO ASCII OCTAL CONVERT .EXTN ERFLG ; ERROR FILE EXISTS FLAG ; DEFINE THE STACK BUFPT= 1 ; BUFFER POINTER TEMP= 2 ; TEMP ***MUST REMAIN AT DISPLACEMENT 2 PEND= TEMP ; STACK SIZE PEND FSERR: LDA 2,ERMSK ; MASK OUT NOISE BITS AND 2,0 STA 0,TEMP,3 ; SAVE ERROR CODE STA 1,BUFPT,3 ; SAVE POINTER TO CALLERS BUFFER LDA 2,@.ERFLG COM# 2,2,SNR ; ERROR FILE ARROUND ?? JMP UNID1 ; NO JUST PRINT NUMBER SUBZ# 0,2,SNC ; ERROR CODE WITHIN RANGE ?? JMP UNID ; NO 3GIVE UNKNOWN ERROR CODE LDA 1,C40 LDA 2,C400 SUBZ# 2,0,SZC ; GREATER THAN OR = TO 400 ?? ADDZL 0,1,SKP ; YES ADD 40 MOVZL 0,1 SUB 0,0 S SPOS ERCH ; POSITION TO POINTER TO MESSAGE JMP UNID ; CAN'T FIND IT GIVE UNKNOWN MESSAGE LDA 0,.TMP ; POINTER TO TEMP ON STACK MOV 0,1 ; ALSO BYTE COUNT ADDZL 3,0 ; MAKE DISPLACEMENT A BYTE POINTER S RDS ERCH ; READ BYTE POINTER TO MESSAGE JMP UNID SUB 0,0 ; FORM POSITION OF MESSAGE SNZ TEMP ; MESSAGE AROUND ?? JMP UNID ; NO GIVE UNIDEF MSG S SPOS ERC H ; POSITION FILE JMP UNID LDA 0,BUFPT,3 ; AC0 -> USERS SPACE S RDL ERCH ; READ THE MESSAGE JMP UNID NEG 0,0 ; POINT TO END OF MESSAGE ADC 0,1 LDA 2,SSOSP,3 ; RETURN POINTER TO CALLER STA 1,SSAC1,2 RTRN ; THATS ALL FOLKS UNID: LDA 0,UNERM ; AC0 -> UNKNOWN ERROR MESSAGE JMP COMIN UNID1: LDA 0,ERM ; AC0 -> ERROR MESSAGE COMIN: LDA 2,SSOSP,3 LDA 1,SSAC1,2 ; AC1 -> WHERE TO PUT MESSAGE C MOVE ; MOVE MESSAGE IN MOV 1,0 ; AC0 -> WHERE TO PUT IT LDA 1,SSAC0,2 ; AC1 = ERROR CODE C BSPAO ; CONO!VERT CODE TO OCTAL STA 0,SSAC1,2 ; RETURN POINTER TO END OF STRING RTRN .ERNUL: ERNUL .ERFLG: ERFLG C40: 40 C400: 400 .TMP: TEMP ** .DO BCOND .UEROP: UEROP ERMSK: 1777 ** .ENDC J ERMSK: 77777 **[J] ** .DO BCOND FERM1: FER1*2 FERM2: FER2*2 ** .ENDC ERMS1: ERM1*2 ERMS2: ERM2*2 ERM: ERMS*2 UNERM: UNKMS*2 ; ; ERROR HANDLERS ; .ENT ERR1 ; REPORT ERROR WITH FILENAME .ENT ERR2 ; REPORT ERROR- NO FILENAME .EXTN WRLIN ; FORMAT AND WRITE A LINE ** .DO BCOND .EXTN UEROP ; USER ERROR OPTION WORD ** .ENDC ; DEFINE THE STACK OFL= 1 OFL ERR1: STA 0,OFL,3 ; SAVE FILENAME POINTER LDA 1,SSAC2,2 ; ERROR OPTION + CODE ** .DO BCOND LDA 3,@.UEROP ; USER ERROR OPTION WORD AND# 1,3,SNR ; FATAL ERROR ? JMP NOFT1 ; NO- USE NON-FATAL MESSAGE LDA 0,FERM1 ; YES- USE FATAL ERROR MESSAGE ISZ SSRTN,2 ; AND BUMP TO FATAL RETURN. JMP CKNL1 ; GO CHECK FOR INVISIBLE CODE NOFT1: ** .ENDC LDA 0,ERMS1 ; USE NON-FATAL ERROR MESSAGE ** .DO BCOND CKNL1: ** .ENDC LDA 3,ERMSK ; MASK FOR ERROR CODE AND 3,1 ; MASK OFF ERROR OPTI$ON CODE(S) LDA 3,.ERNUL ; INVISIBLE ERROR CODE SNE 3,1 ; ANYTHING TO SAY ? RTRN ; NO- SKIP OUT NOW C WRLIN ; YES- WRITE OUT ERROR MESSAGE SSAC1 ; ERROR CODE OFL ; FILENAME RTRN 0 ERR2: LDA 1,SSAC2,2 ; ERROR OPTION + CODE ** .DO BCOND LDA 3,@=m.UEROP ; USER ERROR OPTION WORD AND# 1,3,SNR ; FATAL ERROR ? JMP NOFT2 ; NO- USE NON-FATAL MESSAGE LDA 0,FERM2 ; YES- USE FATAL ERROR MESSAGE ISZ SSRTN,2 ; AND BUMP TO FATAL RETURN. JMP CKNL2 ; GO CHECK FOR INVISIBLE CODE NOFT2: ** .ENDC LDA 0,ERMS2 e; USE NON-FATAL ERROR MESSAGE ** .DO BCOND CKNL2: ** .ENDC LDA 3,ERMSK ; MASK FOR ERROR CODE AND 3,1 ; MASK OFF ERROR OPTION CODE(S) LDA 3,.ERNUL ; INVISIBLE ERROR CODE SNE 3,1 ; ANYTHING TO SAY ? RTRN ; NO- SKIP OUT NOW C WRLIN ; YES- WRITE OUT +ERROR MESSAGE SSAC1 ; ERROR CODE RTRN ** .NOLOC 1 ** .DO BCOND==1 ** .TXTN 1 FER1: .TXT *FATAL ERROR: * ** .TXTN 0 ** .ENDC ERM1: .TXT *^E: ^C<15>* ** .DO BCOND==1 ** .TXTN 1 FER2: .TXT *FATAL ERROR: * ** .TXTN 0 ** .ENDC ERM2: .TXT *^E<15>* ** .TXTLծN 1 UNKMS: .TXT *UNKNOWN * ** .TXTN 0 ERMS: .TXT *ERROR CODE * ** .NOLOC 0 MKABS.SR5  ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CMKABS .RB CMKABS.RB ** .ENDC J .TITL BMKABS .RB BMKABS.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT CKMAB ; "MKABS" BEDGINNING .EXTN CALL,RTRN .EXTN MKFIL,VRFIL,.ASCB,GETARG,GETSW .EXTN ERR1,ERR2 ICH= COMCH ; INPUT CHANNEL ** .DO CCOND OCH= PUSCH ; OUTPUT CHANNEL ** .ENDC J OCH= TMPCH ; OUTPUT CHANNEL **[J] ARG=1 ; ARGUMENT COUNTER EBADR=ARG+1 ; END BLOCK ADDRESS WORD CPTR=EBADR+1 ; CURRENT INPUT POINTER SWT=CPTR+1 ; GLOBAL SWITCH SAVE WORD SW2=SWT+1 ; LOCAL " FAD=SW2+1 ; FROM ADDRESS FOR MKABS TAD=FAD+1 ; TO ADDRESS FNAME=TAD+1 ; FILENAME STORAGE BUFFER DISPL= FNAME+20; SAVE FILE START ADDR STRAD= DISPL+1 CKVAR= STRAD+1 ; CHECK ARGUMENTS TO "MKABS" CKVAR CKMAB: ISZ SSRTN,2 ADCZL 1,1 ; COUNT ARGUMENTS STA 1,ARG,3 SUBZR 1,1 ; ASSUME NO START STA 1,EBADR,3 ; BLOCK ADDRESS ADCZR 1,1 STA 1,TAD,3 ; INITIAL TO ADDRESS STA 0,CPTR,3 CALL ; GET GLOBAL SWITCHES GETSW STA 2,SWT,3 ; SAVE SECOND SWITCH WORD LDA 0,DOSST ; ASSUME RDOS TYPE START LDA 1,ZSWT AND# 2,1,SZR SUB 0,0 STA 0,DISPL,3 STA 0,FAD,3 ; ALSO FROM ADDRESS CKLP: LDA 0,CPTR,3 ; CURRENT COMMAND BYTE POINTER CALL ; GET AN ARGUMENT1 GETARG JMP CKMA0 ; CHECK FOR TOO FEW STA 0,CPTR,3 ; SAVE POINTER TO NEXT ARGUMENT CALL ; GET THE SWITCHES GETSW STA 2,SW2,3 ; KEEP 2ND BANK SWITCHES LDA 2,FSW AND# 2,1,SNR ; /F? JMP TOBK ; NO - GO CHECK OTHER POSSIBILITIES C .ASCB ; YES - CONVERT ASCII TO BINARY NO. JMP .CKE2 LDA 0,FAD,3 ; EXISTING FROM ADDRESS SUBZ# 0,1,SNC ; LESS THAN EXISTING START ADDRESS ? JMP CKE5 ; YES - CAN'T HAVE THAT STA 1,FAD,3 ; NEW FIRST ADDRESS JMP CKLP ; GO FOR NEXT ARG TOBK: LDA 2,SW2,3 ; RECOVER SWITCHEÿS LDA 1,TSW AND# 2,1,SNR ; /T? JMP STBK ; NO CALL .ASCB .CKE2: JMP CKE2 STA 1,TAD,3 ; NEW LAST ADDRESS JMP CKLP STBK: LDA 1,SSWT AND# 1,2,SNR JMP CKMA2 ; NO "S" SWITCH LDA 2,SWT,3 ; LOCAL /S OVERRIDES GLOBAL AND# 1,2,SNR ; IS GLOBAL /S SET? JMPא .+3 ; NO SUB 1,2 ; YES - TAKE IT OFF STA 2,SWT,3 ; DUMMY CALL ; IS IT NUMBER? .ASCB JMP CKE2 ; NO STA 1,EBADR,3 ; YES, SET IT JMP CKLP ; GET NEXT ARGUMENT CKMA2: LDA 2,DFNAM ; OUTPUT FILE ADDZL 3,2 ; BYTE POINTER INTO STACK LDA 1,ARG,3 ; BUM2|P THE ARGUMENT COUNTER INC 1,1 STA 1,ARG,3 MOV 1,1,SZR JMP SAVF ; SAVE FILE NAME CKMA6: SUB 1,1 CALL ; OK, TRY CREATING THE FILE MKFIL JMP CKE1 ; LOSE BIG MOV 2,0 ; WIN S OPEN OCH JMP CKE1 ; ??!! JMP CKLP DOSST: SCSTR ZSWT: Z.SW SAVF: MOV^L 1,1,SNC ; TOO MANY ARGUMENTS? JMP CKE9 LDA 1,.SV ; IT MAY HAVE A ".SV" EXTENT CALL ; VERIFY THAT THE FILE LIVES VRFIL JMP CKE1 MOV 2,0 S OPEN ICH JMP CKE1 ; ??!! LDA 1,SSWT ; CKECK FOR /S GLOBAL LDA 0,SWT,3 ; GET GLOBAL SWITCH BANK 2 AND# 0,1,SNR JMP CKLP ; GET NEXT ARGUMENT LDA 1,.UST ; IS IT FGRND OR BKGRND ?? LDA 0,DISPL,3 ; FILE START LOC SUBOL 0,1 ; SUB 16 OR 0 BYTE RESULT SUB 0,0 .SYSTM .SPOS ICH ; MOVE IT OUT JMP CKEX LDA 0,BFD ; STACK LOC FOR THIS JUNK ADDZL 3,0 ; BYTE IT FORH SYST CALL STA 0,STRAD,3 ; SAVE THIS NUMBER LDA 1,C2 ; NUM BYTE TO READ .SYSTM .RDS ICH JMP CKEX LDA 0,EBADR,3 ; PICK BFD LOC ON STACK MOV# 0,0,SNR ; =0 ? NO = FGRND UST INCS 0,0 ; GET LOC OF BGRND UST LDA 1,STADR ; NOW ADD DISP FOR STRT ADD ADDZL 0,1 ; ALSO BYTE IT FOR SPOS CALL SUB 0,0 ; ZERO MSH .SYSTM .SPOS ICH JMP CKEX LDA 0,STRAD,3 ; PICK BFG AGAIN LDA 1,C2 .SYSTM .RDS ICH JMP CKEX JMP CKLP ; NOW GO GET NEXT ARGUMENT CKMA0: LDA 0,ARG,3 ; TEST FOR TOO FEW ARGUMENTS MOVL 0,0,SZC JMP CKE0 ; YES LDA 1,FAD,3 ; SPECIFED STRT LDA 0,DISPL,3 ; DISPLACEMENT OF FILE SUBOL 0,1 ; STARTING ADDRESS IN FILE SUB 0,0 ; CLEAR MSH FOR SPOS .SYSTM .SPOS ICH JMP CKEX LDA 1,TAD,3 ; NOW LETS SEE HOW MUCH LDA 0,FAD,3 ; FROM ADDRESS SUBZ 0,1,SJNC ; FORM WORDCOUNT - NEGATIVE ? JMP CKE5 ; YES CAN'T DO LESS THAN ZERO C MKABS ; MAKE THE ABSOLUTE BINARY JMP CLOS FCLOS: LDA 2,SSOSP,3 DSZ SSRTN,2 CLOS: S CLOS ICH NOP S CLOS OCH RTRN RTRN SSWT: 1B2 ; "START BLOCK" SWITCH FSW: 1B5 TSW: 1B3 )STADR: USTSA .UST: UST BFD: EBADR C2: 2 CKE0: LDA 2,.TE0 JMP CKEM ; COMMON ERROR CODE CKE2: LDA 2,.TE2 ; ILLEGAL NUMERIC ARGUMENT JMP ER1X ; COMMON ERROR CODE CKE5: LDA 2,.TE5 ; ADDRESS ERROR CKEM: LDA 3,SSOSP,3 ; OLD STACK POINTER  LDA 0,SSAC0,3 ; PJOINTER TO MKABS JMP ER1X CKE9: LDA 2,.TE9 JMP CKEM ; PICK UP POINTER TO "MKABS" CKEX: LDA 0,CPTR,3 ; ARG POINTER CKE1: ER1X: ER1 3 JMP CLOS JMP FCLOS ; DEFINE CONSTANTS DFNAM: FNAME ; DISPLACEMENT FOR STORED FILE NAME .SV: 2*SV .TE0: CNEAR .TE5: sERADR .TE9: CTMAR .TE2: CILNA SV: .TXT *.SV* ; MAKE ABSOLUTE BINARY ; INPUT: ; AC0: SAVE FILE FIRST ADDRESS ; AC1: TOTAL NUMBER OF WORD TO PUSH OUT ; CHANNEL 2 - INPUT FILE ; CHANNEL 3 - OUTPUT FILE ; CALLING SEQUENCE: ; CALL ; MKABS ; ^RETURN 44; STACK DISPLACEMENTS WDCNT= 1 ; WORD COUNT ; (LEAVE AT DISP. 1) ADR= WDCNT+1 CKSM= ADR+1 DAT0= CKSM+1 COUNT= DAT0+21 RFLAG= COUNT+1 SAVED= RFLAG+1 TEMP= SAVED+1 MKABV= TEMP MKABV MKABS: ISZ SSRTN,2 STA 0,ADR,3 INC 1,1 ; ONE MORE FOR OVERLAP STA 1,COUNT,3 ; LAST ADDRESS SUB 2,2 ; CLEAR REPEAT BLOCK FLAG STA 2,RFLAG,3 MKAB1: LDA 2,RFLAG,3 ; ACCOUNT FOR WORD LEFT OVER BY REPEAT BLOCK SUB 0,0 ; CLEAR REPEAT FLAG STA 0,RFLAG,3 LDA 0,C20 SUB 2,0 ; IF ANY SUBZ 0,1,SNC ; TAKE OFF WORD TOTAlL ADD 1,0 ; WENT OVER - SUBTRACT DIFFERENCE STA 1,COUNT,3 ; REPLACE IT MOVZL 0,1 ; MAKE IT A BYTE COUNT LDA 0,DTADIS ; DATA WORDS DISPLACEMENT ADD 2,0 ; AGAIN ACCOUNT FOR LEFT OVER WORD ADDZL 3,0 S RDS ICH ; READ THE SAVE FILE JMP EOF ; TEST FORA EOF ADD 2,1 ; STILL ACCOUNTING FOR LEFT OVER WORD ADD 2,1 MKAB0: NEGOR 1,1 ; NEGATIVE WORD COUNT STA 1,WDCNT,3 C TMDAT ; TEST FOR MULTIPLE DATA BLOCK JMP MEROR ; AN ERROR REPORT C CKSUM ; COMPUT THE CHECKSUM LDA 2,C3 ; FORM THE BLOCK BYTE COUNT  SUB 1,2 MOVZL 2,1 INCZL 3,0 ; BYTE POINTER TO STACK S WRS OCH ; OUTPUT THE BLOCK JSR MEROR LDA 0,ADR,3 LDA 2,WDCNT,3 MOVS 2,2 LDA 1,C20 ; COUNT > 16? ADDZ# 1,2,SNC INC 2,2 ; YES, ADJUST TO CORRECT COUNT MOVS 0,0 SUB 2,0 ; COMPUTE NEXT ADDRES-S STA 0,ADR,3 LDA 0,SAVED,3 ; MOVE SAVED WORD INTO WORD 0 STA 0,DAT0,3 ; JUST IN CASE WE NEED IT LDA 1,COUNT,3 ; RELOAD WORDS YET TO GO ADDO# 1,1,SBN ; ANYTHING LEFT ? JMP ENDBK ; NO - STOP JMP MKAB1 ; YES, KEEP WRITING EOF: LDA 0,EOFCD SUB# 0,2,SZR ; EOF CODE? JSR MEROR ; NO LDA 2,RFLAG,3 ; ADD COUNT LEFT OVER ADD 2,1 MOV 1,1,SZR ; ANY BYTES READ? JMP MKAB0 ; YES, JUMP BACK IN ENDBK: SUBZL 0,0 ; FORMAT A START BLOCK MOVS 0,0 STA 0,WDCNT,3 LDA 2,SSOSP,3 ; CKMAB STACK PTR LDA 0,EBADR,2 ; CSTARTING ADDRESS MOVS 0,0 STA 0,ADR,3 COM 0,0 ; -(ADR+1) IS CHECKSUM STA 0,CKSM,3 LDA 1,C6 INCZL 3,0 S WRS OCH ; WRITE IT JSR MEROR JMP CLOS ; CLOSE + RETURN ; TEST FOR A MULTIPLE DATA BLOCK ; IF TRUE, OUTPUT IN THE FOLLOWING FORM: ; -(DATA COUNT + 1) ; ADDRESS ; CHECKSUM ; DATA TWRD=1 ; TEST WORD TWRD TMDAT: ISZ SSRTN,2 ; BUMP RETURN LDA 0,C20 ; ONLY CHECK DATA BLOCKS ADD# 1,0,SZR ; OF 16 WORDS RTRN ; NO NEG 0,0 INC 0,0 LDA 1,DAT0,2 ; GET FIRST TWO WORDS STA 1u ,TWRD,3 ; SAVE WORD FOR COMPARE LATER TMDA1: LDA 3,DAT0+1,2 SUB# 1,3,SZR ; EQUAL? RTRN ; NO, RETURN INC 2,2 ; YES, END OF BLOCK INC 0,0,SZR JMP TMDA1 ; NO, KEEP COMPARING LDA 3,USP ; OK, A MULTIPLE DATA BLOCK LDA 2,SSOSP,3 ADC 0,0 ; RETURN -1 TO? AC1 STA 0,SSAC1,2 SUBZL 1,1 ; SET REPEAT FLAG STA 1,RFLAG,2 LDA 0,.SAVD ; FORM POINTER TO SAVED ON OLD STACK ADDZL 2,0 ; TO READ THE WORD INTO; THUS STA 0,TEMP,2 TMDA2: DSZ WDCNT,2 ; RST- (-WC) LDA 1,COUNT,2 ; RST- # WORDS LEFT SGTZ 1 ; RST- ANY?^ RTRN ; RST- NO DSZ COUNT,2 ; ONE LESS TO DO NOP ; IT HAPPENS OCCASIONALLY LDA 0,TEMP,2 ; RST- RESTORE BYTE POINTER LDA 1,C.2 ; READ ONE WORD S RDS ICH JMP TMERR ; PROBABLY EOF LDA 1,SAVED,2 ; GET WORD LDA 3,TWRD,3 ; OH THE POOR STACK POINTER S*-UB 3,1,SZR ; WORD THE SAME ?? RTRN ; NO - RETURN TO PUNCH ROUTINE STA 0,TEMP,2 ; RST- MY KINGDOM FOR A ; RST- FIFTH AC. LDA 0,C377M ; RST- (-377) ; ; RST- IF THE WORD COUNT RETURNED IS A MULTIPLE OF 400 ; RST- (OCTAL), THE LOADER IGNORES THE NULL BYTE, CAUSING ; RST- THE REST OF THE DATA TO BE INTERPRETED WITH AN ; RST- OFFSET OF ONE BYTE. (HILARIOUS RESULT - REF. STR ; RST- 1365.) ; LDA 1,WDCNT,2 SNE 0,1 ; RST- TO PREVENT THE ABOVE RTRN JMP TMDA2 TMERR: LDA 3,SSOSP,3 ; POINT TO OLD STACK STr2A 2,SSAC2,3 ; RETURN ERROR CODE JUST IN CASE LDA 0,EOFCD SUB 0,2,SZR ; EOF ?? DSZ SSRTN,3 ; NO GIVE ERROR RETURN STA 2,RFLAG,3 ; CLEAR REMAINING FLAG ON GOOD RETURN RTRN ; BY BY C377M: -377 .SAVD: SAVED C20: 20 MEROR: ER2 3 RTRN LDA 2,SSOS!P,3 DSZ SSRTN,2 RTRN ; DEFINE THE CONSTANTS C.2: 2 C3: 3 C6: 6 EOFCD: EREOF ; END OF FILE STATUS CODE DTADIS: DAT0 ; DATA WORDS STACK DISPLACEMENT ; COMPUTE THE CHECKSUM IN THE OLD STACK'S BLOCK STORAGE ; ADJUST THE BLOCK FOR LEFT/RIGHT PACKING 0 CKSUM: LDA 0,WDCNT,2 ; WORD COUNT MOVS 0,3 STA 3,WDCNT,2 MOVS 3,3 ; SWAP FOR THE BACKWARDS OUTPUT LDA 1,C20 ; WORD COUNT > 16 ADDZ# 3,1,SNC ADC 3,3 ; YES, USE APPROPRIATE COUNTER LDA 1,ADR,2 ADD 1,0 ; CHECKSUM, CHECKSUM MOVS 1,1 STA 1,A5DR,2 CKSM0: LDA 1,DAT0,2 ; DATA WORDS ADD 1,0 ; CHECKSUM, CHECKSUM MOVS 1,1 STA 1,DAT0,2 INC 2,2 ; BUMP STACK POINTER INC 3,3,SZR ; DONE? JMP CKSM0 ; NO LDA 3,USP ; YES, RESTORE THE PROPER STACK LDA 2,SSOSP,3 ; POINTER NEG 0,0 MOVS 0,0 STA 0.,CKSM,2 ; THE CORRECT CHECKSUM RTRN .END BUILD.SR5 V ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CBUILD .RB CBUILD.RB ** .ENDC J .TITL BBUILD .RB BBUILD.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT BUILD .EXTN SBUFmR ; SCRATCH BUFFER .EXTN GETSW ; GET SWITCHES .EXTN GETAR ; GET ARGUMENT .EXTN LDBT ; LOAD BYTE .EXTN STBT ; STORE BYTE .EXTN MOVE ; MOVE STRING ROUTINE .EXTN CALL RTRN RCALL .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN MKNMS ; MAKE NAMES .EXTN CLBUF .EXTN MKFIL ; CREATE OUTPUT FILE ; DEFINE THE STACK OPC= 1 ; OUTPUT COUNTER OUTF= OPC+1 ; POINTER TO OUTPUT FILE NAME TMP= OUTF+1 ; TEMP IPT= TMP+1 ; INPUT POINTER LARG= IPT+1 ; ADDRESS OF LAST ARGUMENT OUTP= LARG+1 ; OPTPUT POINTER NSW= OUTP+1 ; /N FLAG KSW= NSW+1 ; /K SWITCH ASW= KSW+1 ; /A SWITCH OBUFP= ASW+1 ; POINTER TO OBUF OBUF= OBUFP+1 ; OUTPUT BUFFER STACK= OBUF+40+30 ; STACK SIZE STACK BUILD: ISZ SSRTN,2 ; SET GOOD RETRN STA 0,OUTF,3 ; SAVE INPUT POINTER C GETSW ; GET GLVOBAL SWITCHES SW A K N ; TEST SWITCHS LDA 0,OUTF,3 ; RESTORE POINTER C GETAR ; GET OUTPUT FILE NAME JMP @.NOARG ; GOOD GRIEF STA 0,OUTF,3 ; SAVE POINTER TO OUTPUT FILE NAME SUB 1,1 ; DON'T SUPPRESS ANYTHING MOV 0,2 ; COPY NAME TO SELF C MKFIL ;g DELETE/CREATE OUTPUT FILE JMP ER1X ; GOOD LUCK S OPEN COMCH ; OPEN OUTPUT FILE JMP ER1X ; WE TRIED LDA 0,OUTF,3 ; TRY FOR FIRST ARGUMENT BUTAR: C GETAR ; LOOK FOR AT LEAST ONE ARG JMP @.NOARG ; GOOD GRIEF !!! C GETSW ; GET IT'S SWITCHES LDA 2,NS.W AND# 2,1,SZR ; /N ?? JMP BUTAR ; DOESN'T COUNT LDA 2,.SBUFR ; SET UP BUFFER FOR NAMES C CLBUF SUB 0,0 SNZ ASW ; /A ?? LDA 0,.ATPER ; NO - NO PERM FILES SKZ KSW ; LINKS ?? LDA 1,.ATLNK ; NO MASK THEM OUT ADD 0,1 ; AC1= SKIP MASK ADC 2,2 ; AC2= WANT MASK LDA 0,OUTF,3 ; POINT TO INPUT ARGS C MKNMS ; MAKE THE NAMES JMP ERTRN ; SOMETHING WRONG HERE LDA 2,.SBUFR ; POINT TO BUFFER LDA 0,BFRPT,2 ; SET INPUT POINTER STA 0,IPT,3 CLER OPC LARG ; CLEAR THE WORLD BPT OBUF OBUFP ; POINT TO BUFFER BUIL0: STA 1,OUTP,3 ; RESET OUTPUT POINTER BUIL1: LDA 0,IPT,3 ; GET A CHARACTER ISZ IPT,3 C GCBUF MOVS 1,0,SNR ; END OF ARGUMENT ?? JMP BENDA ; YES GO PROCESS MOVZL# 0,0,SZC ; END OF FILE ?? JMP BUEOF ; YES CLOSE UP LDA 0,BPER SUB# 1,0,SNR ; START OF EXTENTION ?? JMP EXTEN ; YES PROCESS IT BUIL2: STORB OUTP ; STORE THE BYTE IN OUTPUT FILE ISZ OPC,3 ; BUMP LINE POSITION JMP BUIL1 ; TRY NEXT NS.W: N.SW .SBUFR: SBUFR .NOARG: NOARG EXTEN: LDA 0,NSW,3 MOV 0,0,SNR ; EXTENTIONS ?? JMP BUIL2 ; YES GO STORE IT EXTE1: LDA 0,IPT,3 ; NO SKIP THEM ISZ IPT,3 C GCBUF MOV 1,1,SZR ; END OF EXT ?? JMP EXTE1 ; NO KEEP LOOKING BENDA: LDA 1,COMA ; STORE A COMMA STORB OUTP ISZ OPC,3 ; BUMP OUTPUT POINTER LDA 0,LARG,3 ; GET START OF ARG STA 0,TMP,3 LDA 1,OPC,3 ; CARG BECOMES NEW LARG STA 1,LARG,3 LDA 0,D70 SUBZ# 0,1,SNC ; EXCEDED COL 70 ?? JMP BUIL1 ; NO CONTINUE LDA 1,TMP,3 ; GET COUNT LDA 0,OBUFP,3 ; WRITE OUT WHAT WE HAVE S WRS COMCH JMP OUTER LDA 0,MSEOL ; WRITE "^<15>" S WRL COMCH JMP OUTER SUB 1,1 ; STORE TRAILING NULL STORB OUTP LDA 0,TMP,3 ; MOVE REMAINDER OF LINE LDA 1,OBUFP,3 ; TO BEGINING OF BUFFER ADD 1,0 C MOVE STA 1,OUTP,3 ; OUTP POINTS TO NULL LDA 0,OBUFP,3 SUB 0,1 STA 1,OPC,3 ; SET OPC CLER LARG ; LAST A#RG = BOL JMP BUIL1 ; DO NEXT ARG BUEOF: LDA 1,OPC,3 MOV 1,1,SNR ; ANYTHING IN LAST LINE JMP BUCLS ; NO FORGET IT SBI 1,1 ; DROP COMMA AT END LDA 0,OBUFP,3 ; YES WRITE OUT LAST LINE S WRS COMCH JMP OUTER LDA 0,MSEOL ; PUT OUT END OF LINE S WRL COMCH JMP OUTER JMP BUCLS ; CLOSE OUTPUT CHANNEL OUTER: LDA 0,OUTF,3 ; AC0 => OUTPUT FILE NAME ER1X: ER1 JMP ERCLS ERTRN: LDA 2,SSOSP,3 DSZ SSRTN,3 ERCLS: S CLOS COMCH ; CLOSE OUTPUT FILE RTRN ; ALL DONE LDA 0,OUTF,3 ; IT WAS OPEN - GET RID OF >IT S DELE NOP RTRN ; DONE NOARG: LDA 2,.CNEAR ; SEND NOT ENOUGH ARGS LDA 3,SSOSP,3 LDA 0,SSAC0,3 JMP ER1X BUCLS: S CLOS COMCH ; CLOSE OUTPUT CHANNEL NOP RTRN ; THAT'S IT .ATLNK: ATLNK .ATPER: ATPER .CNEAR: CNEAR BPER: ". COMA: ", D70: 70. MSqEOL: .+1*2 .TXT /^<15>/ OVSBRS.SR5 ^ ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL COVSBRS .RB COVSBRS.RB ** .ENDC J .TITL BOVSBRS .RB BOVSBRS.RB **[J] .NREL .TXTM 1 ; PACK 'EM LEFT TO RIGHT .ENT PCLI ; READ (F)CLI.CM INTO TBUFF .ENT TRACE ; TRACE COMMAND LINE TO LOG FILE .EXTN CALL RTRN ; LINKING ROUTINES .EXTN RDLIN ; READ LINE INTO A BUFFER .EXTN STBT ; STORE A BYTE .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN PCBUF ; PUT CHARACTER INTO BUFFER .EXTNP PUSHB ; PUSH BUFFER STATE .EXTN TBUFR ; TBUFF HEADER .EXTN CBUFR ; CBUFF HEADER .EXTN SPYF ; LOG FILE FLAG .EXTN LOGER ; LOG FILE ERROR ROUTINE ; ; PCLI- ; READ (F)CLI.CM INTO TBUFF ; ON ENTRY, AC0 = CURRENT POSITION IN BUFFER ; ON RETURN, AC0 = WHERE TO CONTINUE SCANNING IN BUFFER ; ; DEFINE THE STACK CRPOS= 1 ; PLACE TO STORE CURRENT POSITION STACK= CRPOS ; STACK SIZE STACK PCLI: STA 0,CRPOS,3 ; SAVE CURRENT POSITION ; OPEN THE COMMAND FILE LDA 2,USTP ; AC2 => UST LDA 2,USTPC,2 LDA 0,CLTICP ; AC0 => FCLI.CM MOV 2,2,SNR ; FORGROUND ? INC 0,0 ; NO AC0 => CLI.CM S OPEN PUSCH ; OPEN THE FILE JMP PUSER ; ERROR ON OPEN ; SET UP TBUFF FOR COMMAND FILE LDA 0,CRPOS,3 ; AC0 = CURRENT POSITION IN TBUFF LDA 2,TBUFP ; AC2 => TBUFF HEADER CE GCBUF ; GET NEXT CHARACTER LDA 0,PUEOT ; IF IT IS NOT AN EOT SUB# 0,1,SZR ; THEN PUSH BUFFER JMP PUPSH ; STATE ELSE LDA 0,BFRPT,2 ; RESET START OF STA 0,BFFFB,2 ; BUFFER FRAME JMP PUSHM ; AND GO READ FILE PUPSH: LDA 1,CRPOS,3 ; AC1 = CURRENT POSITI-wON C PUSHB ; PUSH BUFFER STATE ; READ COMMAND FILE INTO TBUFF PUSHM: LDA 1,.PUSCH ; AC1 = CHANNEL PUSH1: C RDLIN ; READ A LINE JMP PUSH2 ; END OF FILE CLOSE UP JMP PUSH1 ; KEEP READING TILL END OF FILE PUSH2: S CLOS PUSCH ; CLOSE CHANNEL NOP LDA H2,TBUFP ; RESTORE AC2 IN CASE OF ERROR. DSZ BFFFB,2 ; IF MORE THAN ONE BYTE IN BUFFER JMP CHKCR ; THEN SEE IF THERE IS A C/R JMP PUTBK ; ELSE JUST RESTORE EOT. CHKCR: LDA 0,BFFFB,2 ; PICK UP FREE BYTE POINTER NEG 0,0 ; AND BACK IT UP ONE CHAR COM 0,0m ; BEFORE EOT. C GCBUF ; GET CHARACTER- LDA 0,PUEOL ; IF IT IS SUB# 0,1,SNR ; A C/R THEN JMP PUTBK ; JUST RESTORE EOT ELSE MOV 0,1 ; STORE A C/R TO INSURE C PCBUF ; PROPER PROCESSING . PUTBK: LDA 1,PUEOT ; RESTORE EOT C PCBUF ; IN TBUFF. ; RES}ET COMMAND BUFFER FOR NEXT COMMAND AND RETURN LDA 2,CBUFP ; AC2 => CBUFF HEADER LDA 0,BFRPT,2 ; SET END OF BUFFER STA 0,BFFFB,2 ; = BEGINNING OF BUFFER. LDA 2,TBUFP ; AC2 => TBUFF HEADER LDA 0,BFRPT,2 ; AC0 => BEGINNING OF BUFFER FRAME PSHEX: LDA 2,SSOSP,3 ; AC2 <= OLD STACK POINTER STA 0,SSAC0,2 ; RETURN POINTER TO WHERE TO SCAN RTRN ; THAT'S ALL ; ERROR ON OPEN PUSER: ER1 ; REPORT ERROR LDA 0,CRPOS,3 ; CONTINUE SCAN WHERE JMP PSHEX ; WE LEFT OFF CLICP: .+1*2 ** .NOLOC 1 .TXT *FCLI.CM* ** . CBUFF HEADER LDA 0,BFRPT,2 ; PICK UP => TO START OF COMMAND LINE STA 0,INPUT,3 ; AND PUT IT IN THE STACK ; START A NEW LINE LINLP: BPT OUTBF OUTwBP ; FORM OUPUT BUFFER POINTER STA 1,OUTRP,3 ; AND A RUNNING POINTER. LDA 1,TRSY1 ; STORE TWO STORB OUTRP ; "=" TO START STORB OUTRP ; THE TRACE LINE LDA 1,TRSY2 ; FOLLOWED BY STORB OUTRP ; A ">" TO HIGHLIGHT THE LINE. LDA 0,K69 ; SET 69 AS MAXIMUM NUMBER STA 0,CNT,3 ; INPUT CHARS/LINE. ; GET CHARS FROM COMMAND BUFFER TO FORM LINE CHRLP: LDA 0,INPUT,3 ; AC0 <= INPUT POINTER ISZ INPUT,3 ; BUMP THE POINTER LDA 2,.CBUFR ; AC2 => CBUFF HEADER C GCBUF ; GET A CHARACTER LDA 0,.SEMI ; IS THIS CHARAKCTER SUB# 0,1,SNR ; A SEMI-COLON ?? JMP ENDLI ; YES- END OF COMMAND LINE LDA 0,.CAR ; IS THIS CHARACTER SUB# 0,1,SNR ; A CARRIAGE RETURN ?? JMP ENDLI ; YES- END OF COMMAND LINE STORB OUTRP ; NO- STORE IT IN OUTPUT BUFFER DSZ CNT,3 ; ROOM F8OR MORE CHARS? JMP CHRLP ; YES- GET ANOTHER ONE ENDLI: LDA 1,.CAR ; NO- STORE A C/R STORB OUTRP ; IN OUTPUT BUFFER. LDA 0,OUTBP,3 ; AC0 => OUTPUT BUFFER S WRL KCH ; WRITE LINE TO LOG FILE JMP @.LOGER ; BAD NEWS !!! LDA 0,CNT,3 ; PICK UP CHARACTER COUʩNT- MOV# 0,0,SNR ; IF IT WAS = 0 JMP LINLP ; THEN THERE ARE MORE LINES RTRN ; ELSE WE ARE DONE. .SPYF: SPYF .CBUFR: CBUFR .LOGER: LOGER TSW: T.SW TRSY1: "= TRSY2: "> K69: 69. .CAR: EOL .SEMI: SEMI ASCB.SR5 H ; ; ; ASCII OCTAL TO BINARY (SINGLE PRECISION). ; AC0 POINTS TO STRING (ENDS WITH NULL). ; AC1 RETURNS THE NUMBER ; CALL ; .ASCB ; -OVERFLOW OR ILLEGAL CHAR. RTURN ; -NORMAL RETURN ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T g LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CASCB .RB CASCB.RB ** .ENDC J .TITL BASCB .RB BASCB.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT .ASCB .EXTN CALL,LDBT,RTRN NUMB=1 CHAR=NUMB+1 PEND=CHAR PEND .ASCB: SUB 2,2 ; NUMBER IS ZERO TO START .LP: STA 2,NUMB,3 ; SAFE KEEPING C LDBT ; GET A BYTE MOV# 1,1,SNR ; LOOK FOR TERMINATING NULL JMP .FIN ; AND QUIT INC 0,0 STA 1,CHAR,3 ; SAVE IT LDA 2,C370 ; MASK AND 1,2 ; LOOK FOR LEGAL CHAR. LDA 1,C60 SUB# 1,2,SZR ; 6N OCTAL ON-LY PERMITTED ONES JMP ERR LDA 1,CHAR,3 ; CHAR. AGAIN LDA 2,C7 ; BIT MASK AND 2,1 ; MASK OFF LDA 2,NUMB,3 MOVZL 2,2,SZC ; MUL. BY 8 LOOKING FOR OVERFLOW JMP ERR ; OVERFLOW MOVZL 2,2,SNC MOVZL 2,2,SZC JMP ERR ADD 1,2 ; UPDATE NUMBER JMP .LP .lFIN: LDA 3,SSOSP,3 ; OLD STACK POINTER IN AC3 STA 2,SSAC1,3 ISZ SSRTN,3 ; MAKE FOR NORMAL RETURN RTRN ERR: LDA 3,SSOSP,3 ; RETURN ERROR CODE LDA 2,.CILNA STA 2,SSAC2,3 RTRN .CILNA: CILNA C370: 370 C60: 60 C7: 7 .END LIST.SR5 7 ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CLIST .RB CLIST.RB ** .ENDC J .TITL BLIST .RB BLIST.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT LIST .EXTN LIS2 ; ENTRY POINT TO THE SECOND HALF OF LIST .EXTN LIS2E ; LIST OVERLAY NUMBER .EXTN SWAPR ; SWAP ROUTTINE ADDRESS .EXTN GETAR ; GET ARGUMENT .EXTN GETSW ; GET SWITCHES .EXTN GETSP ; GET SWITCH POINTER .EXTN SETSW ; SET SWITCH ROUTINE .EXTN BFMVI ; BUFFER M2OVE LINE .EXTN PCBUF ; PUT CHARACTER BUFFER .EXTN CLBUF ; CLEAR BUFFER ROUTINE .EXTN SBUFR ; SCRATCH BUFFER .EXTN LDBT STBT .EXTN LDBI STBI .EXTN CALL RTRN RCALL .EXTN WRBIN .EXTN CMOVE .EXTN .INDEX .EXTN .ASCD INDEX ; DEFINE THE STACK ARGSW=] 1 ; ARGUMENT SEEN SWITCH ASW= ARGSW+1 ; ATTRIBUTES TO IGNORE OSW= ASW+1 ; ATTRIBUTES TO LOOK FOR IP= OSW+1 ; INPUT POINTER BPTR= IP+1 ; POINTER TO FILE TABLE ADATE= BPTR+1 ; AFTER DATE BDATE= ADATE+1 ; BEFORE DATE NAMEP= BDATE+1 ; POINTER TO NAME NBP= NAMEP+1 ; POINTER TO BUFF NAME= BP+1 ; SPACE FOR FILE NAMES BUFH= NAME+12 ; BUFFER HEADER ADDRESS BUFF= BUFH+2 ; BUFFER ADDRESS STACK= BUFF+401; STACK SIZE ** .DO CCOND SYSCH= PUSCH ** .ENDC J SYSCH= TMPCH **[J] 0 LIST: LDA 2,SBUFP ; CLEAR SBUFR C CLBUF C GETSW ; GET THE GLOBAL SWITCHES SUB 2,2 LDA 0,AS.W AND# 0,1,SNR ; /A ?? LDA 2,.ATPER ; NO - NO PERMANENT FILES LDA 0,KS.W AND 1,0,SNR ; LINKS ?? SUB 0,0,SKP ; NO - ALLOW THEM LDA 0,.ATLNK ADD 0,2 LDA 0,NS.W ; OTHER FILES BESIDES LINKS AND 1,0,SNR ; WELL ?? ADC 0,0,SKP ; YES ALLOW ALL LDA 0,.ATLNK ; NO LINKS ONLY MOV 2,1 MOV 0,2 LDA 3,SSOSP,3 ; GET ARGUMENT POINTER LDA 0,SSAC0,3 C MKNMN ; MAKE LIST OF NAMES RTRN ; ANY ERROR IS BAD NEWS LDA 2,SSOSP,3 ; LOAD MAIN L BUFFER (401 WORDS) ; AC1 = CHANNEL NUMBER ; CALL ; RDSIN ; -ERROR RETURN ; -NORMAL RETURN ; ; -2 CHANNEL# ; -1 CURRENT LOGICAL BLOCK# ; 0 ENTRY PTR ; 1 (BEG OF BLK) ENTRY COUNT ; 2 FIRST ENTRY 0 RDSIN: ISZ SSRTN,2 MOVZR 0,2 SUB 0,0 STA 0,1,2 STA 0,-1,2 ; BEGIN WITH BLOCK 0 INCS 0,0 ; MAKE 400 ADD 1,0 ; CHANNEL+BLOCK INCREMENT STA 0,-2,2 MOV 1,2 LDA 0,DIRNP S ROPEN CPU JMP SERR RTRN DIRNP: .+1*2 DIRN: .TXT /SYS.DR/y SERR: LDA 3,SSOSP,3 DSZ SSRTN,3 STA 2,SSAC2,3 RTRN ; ; READ NEXT ENTRY FROM SYS.DR ; AC0 -> BUFFER ; AC1 = CHANNEL # ; AC2 = RETURNED ENTRY ADDRESS ; CALL ; RDSYS ; -ERROR OR EOF (CODE IN AC2) ; -NORMAL RETURN CHAN=1 1 RDSYS: ISZ SSRTN,2 ; ASSUM\mE NORMAL RETURN MOVZR 0,2 ; BUILD BUFFER ADDRESS .LOOP: LDA 0,1,2 MOV# 0,0,SZR JMP ENTF INC 2,0 LDA 1,-1,2 ISZ -1,2 LDA 2,-2,2 S RDB CPU JMP SERR NEG 0,2 COM 2,2 INC 0,0 STA 0,0,2 JMP .LOOP ENTF: LDA @0,0,2 ; NAME WORD MOVZ 0,0,SZR MOVO 0k,0 ; SET CARRY IF NON VACENT LDA 0,ENTSZ LDA 1,0,2 ADD 1,0 STA 0,0,2 MOV# 0,0,SNC JMP .LOOP DSZ 1,2 JMP .+1 LDA 2,SSOSP,3 STA 1,SSAC2,2 RTRN ENTSZ: UFDEL ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2 = SYSTEM NAME ADDRESS ; CALL ; SNkTUN EXTX=1 ; EXTENSION SOTRAGE .STSZ=1 ; FRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE IN STACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZL 2,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX C WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN LINEX: .+1*2 .TXT /^C.^W/ ; ROUTINE TO COMPARE SYSTEM NAME WITH ; A USER NAME. ; AC1 POINTS TO THE SYSTEM NAME ; AC0 POINTS TO THE UdSER NAME ; THIS HAS BEEN COMPLETLY REWRITTEN JUNE 26 72 ; THIS CHANGES THE ASTERISK CONVENTION OF THE COMMAND LINE INTERPRETER ; * WILL MATCH ANY SINGLE CHARACTER ; -(MINUS SIGN) WILL MATCH ANY NUMBER (INCLUDING 0) OF CHARACTERS ; CALL ; CMPNM ; - NO MATRCH RETURN ; - MATCH RETURN SPNT =1 ; HOLDS POINTER TO SYSTEM NAME UPNT =SPNT+1 ; POINTER TO USER NAME SCNT =UPNT+1 ; # OF CHAR LEFT IN SYSTEM NAME UCNT =SCNT+1 ; # LEFT IN USER NAME TO PROCESS STXSX =UCNT ; STACK SIZE NEEDED FOR UNMSCN ROUTINE SEXT :=UCNT+1 ; POINTS TO SYSTEM NAME EXTENSION STYSZ =SEXT ; STACK SIZE NEED FOR CMPNM ROUTINE STYSZ CMPNM: ; COMPARE SYSTEN NAME ROUTINE START ADDRESS ; ALL REGS ARE SAVED ON STACK ON ENTRY ; SAVE START ADDRESS OF NAMES FOR PROCESSING STA 0,UPNT,3 ; SAV8E START OF USER NAME STA 1,SPNT,3 ; AND SYSTEM NAME TO MATCH LDA 0,C12 ; GET MAX SIZE OF NAME ADD 0,1 ; CALC ADDRESS OF SYSTEM NAME EXTENXION STA 1,SEXT,3 ; AND SAVE IT ; SET IN THE MAX # OF CHARS ALLOWED IN SYSTEM AND USER NAMES STA 0,UCNT,3 ; SET &THAT 12 IS HIGHEST STA 0,SCNT,3 ; ALLOWED ; SEE IF THE NAME MATCHES C NMSCN ; GO SCAN THE NAME RTRN ; IF NO MATCH THEN TELL OUR CALLER ELSE ; HAD A MATCH, CHECK IF USER NAME IS ALL DONE(IE ENDED IN ZERO BYTE) L1: LDA 0,UPNT,3 ; GET ADDRESS OF USER NˇAME WHERE MATCH ENDED C LDBT ; GET CHAR MOV# 1,1,SNR ; IF IS ZERO THEN USER NAME IS DONE JMP L2 ; GO MAKE SURE SYSTEM NAME DOES NOT ; HAVE EXTENSION ISZ UPNT,3 ; INC TO NEXT CHAR POSITION IN USER NAME LDA 0,PER ; CHECK FOR PERIOD IN USER NAM2E INDICATING SUB# 0,1,SZR ; AN EXTENSION IS PRESENT, IF NOT THEN JMP L1 ; LOOP TO LOOK MORE AT STRING ELSE ; SET UP TO MATCH THE NAME EXTENSIONS LDA 0,SEXT,3 ; GET ADDRESS OF SYSTEM NAME EXTENSION STA 0,SPNT,3 ; AND SET TO SCAN LDA 0,C2 ; SET MAX SakIZE OF EXTENSION STA 0,SCNT,3 ; TO BE 2 FOR USER AND SYSTEN STA 0,UCNT,3 ; NAMES ; SCAN THE EXTENSION FOR CORRECTNESS C NMSCN ; SCAN THE EXTENSION RTRN ; GIVE UP ON NO MATCH ELSE JMP L3 ; WE HAVE NAMES THAT MATCH ; USER NAME HAS NO EXTENSION, CH>ECK IF SYSTEN NAME HAS EXTENSION L2: LDA 0,SEXT,3 ; GET ADDR OF EXTENSION C LDBT ; GET 1ST CHAR OF IT MOV# 1,1,SZR ; IF HAS EXTENSION THEN RTRN ; NO MATCH ELSE ; WE HAVE A NAME MATCH, RETURN TO CALLER AT MATCH ADDRESS L3: LDA 2,SSOSP,3 ; GET CALLER STACK POINTER ISZ SSRTN,2 ; INC RETURN POINTER TO MATCH ADDR RTRN ; RETURN TO CALLER PER: ". ; PERIOD SEPARATING FILE NAME FROM EXTENASION DASH: "- ; ANY LENGTH MATCH CHAR STAR: "* ; ANY CHAR MATCH C12: 12 ; # OF CHARS IN FILE NAMES C2: 2 ; # OF CHARS IN FILE NAME EXTENSIONS ; INTERNAME ROUTINE FOR "CMPNM" TO TRY FOR MATCH OF WHAT IS LEFT ; OF STRING. ON ENTRY AC2 POINTS TO THE STACK OF THE CALLER ; WHICH CONTAINS WHERE THE CALLER WAS IN COMPARING THE 2 STRINGS. ; THIS ROUTINE STARTS AT WHERE THE /CALLER LEFT OFF AND SCANS THE LINE ; IF NO MATCH THEN RETURNS TO CALLER AT CALL+1 WITH NOTHING CHANGED. ; IF MATCH THEN UPDATES THE USER POINTER IN THE CALLERS STACK TO ; POINT TO THE CHAR THAT ENDED THE COMPARE AND RETURNS AT CALL+2. ; IF ROUTINE ENCOUNTEERS DASH THEN IT CALLS ITSELF WITH THE USER NAME ; POINTER POINTING TO THE CHAR AFTER THE DASH. IF ON RETURN IT HAS A ; MATCH THEN IT RETURNS TO ITS CALLER WITH A MATCH. IF NO MATCH THEN ; INCREMENTS THE SYSTEM NAME POINTER BY ONE AND CALLS ITSELF AGAIN. ;, PROCESS CONTINUES TILL EITHER MATCH OR SYSTEM FILE NAME ; EXHAUSTED. STXSX ; ROUTINE STACK SIZE NMSCN: ; ROUTINE START ADDRESS ; COPY WHERE CALLER WAS AT IN SCAN TO OWN STACK LDA 0,SPNT,2 ; GET WHERE WAS AT IN SYSTEM NAME STA 0,SPNT,3 ; SAVE IN OWnN STACK LDA 0,UPNT,2 ; GET WHERE AT IN USER NAME STA 0,UPNT,3 ; AND STORE LDA 0,SCNT,2 ; GET # CHARS MAX LEFT IN SYSTEM NAME STA 0,SCNT,3 ; AND STORE IT LDA 0,UCNT,2 ; SAME WITH USER NAME STA 0,UCNT,3 ; GET CHAR FROM EACH STRING TO MATCH NM1: LDA 0,UPNT,3 ; PICK UP CHAR FROM C LDBT ; USER STRING MOV 1,2 ; AND SAVE IN AC2 SUB 1,1 ; SET SYSTEM CHAR TO NULL AND LDA 0,SCNT,3 ; IF END OF SYSTEM STRING MOV# 0,0,SNR ; REACHED CHECK TO SEE JMP NM15 ; IF USER CHAR WAS NULL LDA 0,SPNT,3 ; ELSE PfICK UP CHAR C LDBT ; FROM SYSTEM STRING ; CHECK TO SEE IF THEY ARE EQUAL NM15: SUB# 1,2,SZR ; IF NOT EQUAL THEN JMP NM3 ; BRANCH ELSE ; WE HAVE MATCH, SEE IF MATCH IS THAT OF END OF STRINGS MOV# 2,2,SNR ; IF WE ARE AT END OF STRINGS THEN JMP NM5 D ; NAMES MATCH ELSE ; NAMES NOT ALL MATCHED YET, CHECK TO SEE IF HAVE REACHED END OF ; WHAT SHOULD BE PROCESSED IN NAMES NM2: ISZ UPNT,3 ; UPDATE NAME POINTERS TO ISZ SPNT,3 ; NEXT CHAR DSZ SCNT,3 ; COUNT SYSTEM NAME CHAR NOP DSZ UCNT,3 ; IF HAVE NOT MATCHED MAX # USER JMP NM1 ; CHARS THAN GET NEXT CHAR ELSE JMP NM5 ; WE HAVE COMPLETE MATCH ; CHARS DID NOT MATCH, CHECK FOR SPECIAL CHARS NM3: LDA 0,PER ; IF USER NAME CHAR IS A SUB# 0,2,SNR ; PERIOD THEN IS END OF USER JMP NM4 ; USER NAME SO8 BRANCH ELSE LDA 0,DASH ; IF IS DASH THEN GO SUB# 0,2,SNR ; WHAT PART OF REST OF SYSTEM NAME JMP NM9 ; MATCH USER NAME ELSE LDA 0,STAR ; IF IS STAR AND THE SYSTEM SUB# 0,2,SNR ; NAME CHAR IS NOT A ZERO THEN MOV# 1,1,SNR ; SAY THE CHARS MATCH ELĦSE RTRN ; RETURN WITH NO MATCH JMP NM2 ; FOUND PERIOD IN USER NAME, CHECK THAT SYSTEM NAME IS ENDED NM4: MOV# 1,1,SZR ; IF SYSTEM NAME DID NOT END AT RTRN ; SAME POINT AS USER THEN NO MATCH ELSE ; NAMES DO MATCH, RETURN ADDRESS OF WHERE MATCH ENDq`ED IN USER NAME ; TO CALLER. NM5: LDA 2,SSOSP,3 ; GET ADDRESS OF CALLER STACK LDA 0,UPNT,3 ; GET ADDRESS OF USER NAME WHERE ENDED STA 0,UPNT,2 ; RETURN TO CALLER ; INC RETURN ADDR TO SUCCESSFUL RETURN ADRESS AND DONE ISZ SSRTN,2 RTRN ; FOUND DASH IN USER NAME, INC PAST THE DASH NM9: ISZ UPNT,3 ; CHECK, IF DASH WAS LAST CHAR OF NAME THEN WE HAVE A MATCH LDA 0,UPNT,3 ; GET POINTER TO USER NAME C LDBT ; GET NEXT CHAR OF NAME LDA 0,PER ; IF IT IS ENDED THEN SUB# 0,1,SZR ; WE HAVE A MATCH ELSE MOV#[ 1,1,SNR ; WE HAVE NO MATCH JMP NM5 ; MATCH ; SEE IF WHAT IS LEFT OF USER NAME MATCHES WHATS LEFT OF SYSTEM NAME NM10: C NMSCN ; SCAN NAMES FOR MATCH MOV# 1,1,SKP ; IF NO MATCH THEN SKIP ELSE JMP NM5 ; IF MATCH THEN WOOPY, GO RETURN SUCCESS ; DOESb NOT MATCH, SEE IF ANYTHING LEFT OF SYSTEM NAME TO TRY MATCH ISZ SPNT,3 ; INC SYSTEM NAME POINTER TO NEXT CHAR DSZ SCNT,3 ; IF STILL SOMETING LEFT OF NAME THEN MOV# 0,0,SKP ; SKIP ELSE RTRN ; RETURN WITH NO MATCH ; NOT PAST MAX # OF CHARS IN SYSTE-M NAME, STILL CHECK FOR NAME END LDA 0,SPNT,3 ; GET POINTER TO SYSTEM NAME C LDBT ; GET CHAR FROM IT MOV# 1,1,SNR ; IF IS END OF SYSTEM NAME THEN RTRN ; NO MATCH POSSIBLE ELSE JMP NM10 ; GO SEE IF MATCH  TMP= 1 ; TEMP MONTH= TMP+1 ; MONTH/DA Y/YEAR DAY= MONTH+1 YEAR= DAY+1 FEB= YEAR+1 ; FEBUARY DATE= FEB+1 ; ACCUMULATED DATE STACK= DATE ; STACK LENGTH STACK CNVRT: ISZ SSRTN,2 ; ASSUME GOOD RETURN LDA 2,CM3 ; THREE ARGS STA 2,TMP,3 ; SET COUNTER LDA 2,MONTD ; POINT TO MONTH ADD 3,2 TCNVR0: C .ASCD ; CONVERT TO BINARY JMP NUMER ; SOME TYPE OF ERROR STA 1,0,2 ; SAVE VALUE INC 2,2 ; POINT TO NEXT ISZ TMP,3 ; DONE WITH THREE ? JMP CNVR1 ; NO CONTINUE JMP CNVR2 ; YES GO PROCESS CNVR1: LDA 1,DASH ; POINT TO NEXT ARGUMENT C INDEX JMP NUMER ; TRY AGAIN INC 0,0 JMP CNVR0 ; NO CONVERT NEXT CNVR2: LDA 1,YEAR,3 ; YES GET YEAR LDA 0,K1968D ; TRY TO TAKE OUT 1968 SUBZ# 0,1,SNC ; COME OUT ?? LDA 0,K68D ; NO TRY 68 SUBZ 1,0,SEZ JMP NUMER ; BAD YEAR STA 0,YEAR,3 ; SAVE YEAR MOEVZR 0,1,SNC ; A LEAP YEAR PERHAPS ? MOVR 1,1 LDA 2,K14 ; IF SO ADD DAY TO FEB MOVCL 2,2 STA 2,FEB,3 LDA 2,K12 LDA 1,MONTH,3 MOV 1,1,SZR SUBZ# 1,2,SNC ; LEGAL MONTH ?? JMP NUMER ; NO PUNISH LDA 2,MTBL SUB 0,0 ; CLEAR RESULT WORD CNVR3: LDA 1,0,2w ; AC1= DAYS TO THIS MONTH COM# 1,1,SNR ; FEB PERHAPS ?? LDA 1,FEB,3 ; YES GET IT DSZ MONTH,3 ; DONE ? JMP CNVR4 ; NO ADD THIS MONTH JMP DAYS ; YES GO TO DAYS CNVR4: ADD 1,0 INC 2,2 ; BUMP POINTER JMP CNVR3 ; CONTINUE DAYS: LDA 2,DAY,3 ; GET DAYS SUBZ# 2,1,SNC ; DAYS LEGAL ? JMP NUMER ; SHAME ON YOU ADD 2,0 ; YES ADD THEM IN STA 0,DATE,3 ; SAVE DATE YEARS: LDA 0,YEAR,3 ; GET YEAR YEAR1: MOVZ 0,0,SNR ; ZER0 ? JMP FINI ; YES ALL DONE INC 0,0 ; NO BUMP YEAR LDA 2,CM366 ; 365 DAYS PER LEAP YpEAR MOVZR 0,1,SNC ; IS IT LEAP YEAR MOVR 1,1,SZC INC 2,2 ; NO MAKE IT 365 DAYS NEG 2,2 LDA 1,DATE,3 ADD 1,2 STA 2,DATE,3 JMP YEAR1 ; CONTIUE FINI: LDA 2,SSOSP,3 ; RETURN DATE TO CALLER LDA 1,DATE,3 STA 1,SSAC1,2 RTRN NUMER: LDA 3,SSOSP,3 DSZ SSRTN,3 LDA 0,SSAC0,3 ; AC0 => ARGUMENT LDA 2,.ERTIM ; TIME ERROR MESAGE ER1 3 ; GIVE ERROR MESSAGE RTRN ; ALL ERRORS ARE FATAL RTRN MTBL: .+1 31. -1 31. 30. 31. 30. 31. 31. 30. 31. 30. 31. CM3: -3 MONTD: MONTH K1968D: 1968. K68D: 608. K14: 14. K12: 12. CM366: -366. .ERTIM: ERTIM INSTX.SR5 3 F ; ; INSTX- ; INSERT TEXT. ; INSERT TEXT STRING POINTED TO BY AC0, IN BUFFER POINTED ; TO BY AC1, INTO BUFFER POINTED TO BY AC2. ; ON RETURN, AC0 UPDATED TO POINT PAST "TEXT". ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST dVMACRO EXPANSIONS ** .DO CCOND==1 .TITL CINSTX .RB CINSTX.RB ** .ENDC J .TITL BINSTX .RB BINSTX.RB **[J] .NREL .ENT INSTX ; ENTRY POINT .EXTN CALL RTRN ; LINKING ROUTINES .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN PCBUF ; PUT CHARACTER IN BUFFER .EXTN CMDER ; CLI COMMAND ERROR ROUTINE .EXTN LDBI ; LOAD BYTE INCREMENT .EXTN STBT ; STORE BYTE ; DEFINE THE STACK INPUT= 1 ; INPUT POINTER BUFR1= INPUT+1 ; "FROM" BUFFER BUFR2= BUFR1+1 ; "TO" BUFFER CNT= BUFR2+1 ; PLACE TO COUNT TEXT CHARS SCANNED WRKBP= CNT+1 ; WORKING BYTE POINTER TXTBP= WRKBP+1 ; BYTE POINTER TO TEXT BUFFER TXTBF= TXTBP+1 ; PLACE TO STORE TEXT STRING NULL= TXTBF+((72.+2)/2) ; PLACE TO STORE TERMINATOR STACK= NULL ; STACK LENGTH STACK INSTX: STA 0,INPUT,3 ; SAVE POINTER TO INPUT STRING STA 1,BUFR1,3 ; SAVE ADDRESS OF "FROM" BUFFER LDA 2,SSAC2,2 ; PICK UP "TO" BUFFER ADDRESS STA 2,BUFR2,3 ; AND SAVE IT BPT TXTBF TXTBP ; FORM BYTE POINTER TO TEXT BUFFER STA 1,WRKBP,3 ; INITIALIZE WORKING POINTER LDA 0,KMAXL ; SET MAX # TEXT STRING CHARS TO BE STA 0,CNT,3 ; 74 DECIMAL. LDA 1,QUOTE ; STORE LEADING QUOTE JMP INSOK ; JOIN MOVE LOOP INSTL: LDA 0,INPUT,3 ; PICK UP INPUT STRING POINTER ISZ INPUT,3 ; BUMP INPUT POINTER LDA 2,BUFR1,3 ; PICK UP ADDRESS OF "FROM" BUF)WFER C GCBUF ; PUT NEXT BYTE IN AC1 DISP INSTB ; DISPATCH ON IT INSTB: .+1 ; INPUT CHARACTER DISPATCH TABLE QUOTE: 42 ; QUOTE (") INSND ; SUCCESSFUL END OF TEXT STRING EOL ; END OF LINE INSER ; ERROR SEMI ; END OF LINE INSER ; ERROR EOT ; END OF FILE INSER ; ERROR -1 ; ANYTHING ELSE INSOK ; STORE AS PART OF TEXT STRING INSOK: STORB WRKBP ; STORE THE BYTE DSZ CNT,3 ; HAS CHAR LIMIT BEEN REACHED? JMP INSTL ; NO- GET NEXT BYTE JMP INSR1 ; YES- ERROR ; ; END OF TEXT STRING FOUNDj- ; MOVE TEXT STRING TO "TO" BUFFER ; INSND: STORB WRKBP ; STORE TERMINATING QUOTE (") SUB 1,1 ; STORE A NULL STORB WRKBP ; TO COMPLETE TEXT STRING LDA 0,TXTBP,3 ; AC0 => BEGINNING OF TEXT STRING LDA 2,BUFR2,3 ; AC2 => "TO" BUFFER INSML: C LDBI ; GET A BYTE TO AC1 MOV# 1,1,SNR ; IS IT A NULL? JMP INSEX ; YES- DONE MOVING STRING C PCBUF ; NO- STORE BYTE IN BUFFER JMP INSML ; PROCESS NEXT BYTE KMAXL: 72.+2 INSEX: LDA 2,SSOSP,3 ; AC2 GETS CALLER'S STACK POINTER LDA 0,INPUT,3 ; RETURN UPDATED INP5}UT POINTER TO CALLER STA 0,SSAC0,2 ; IN CALLER'S AC0 RTRN ; THAT'S ALL!!! ; ERROR HANDLING INSER: STORB WRKBP ; STORE THE BAD CHARACTER SUB 1,1 ; STORE A TERMINATING NULL STORB WRKBP ; AT END OF STRING LDA 2,.CILTA ; UNMATCHED QUOTE (") LDA 0,TXJTBP,3 ; AC0 => BAD STRING ER1 ; REPORT ERROR JMP INERX ; GO BOMB OUT INSR1: LDA 2,.CTATL ; TEXT STRING TOO LONG ER2 ; REPORT ERROR INERX: JMP @.+1 ; GO BOMB CMDER ; OUT !!!! .CILTA: CILTA .CTATL: CTATL XFER.SR5(&Z ; ; PROGRAMS TO DO FILE TRANSFERS. ; CALLED WITH AC0 POINTING TO THE EDITED COMMAND STRING. ; TWO FILE NAME ARGUMENTS ARE REQUIRED ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CXUFER .RB CXFER.RB ** .ENDC J .TITL BXFER .RB BXFER.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT XFER ; COPY ONE FILE TO ANOTHER .ENT PRINT ; PRINT A FILE ON LINE PRINTER .ENT PUNCH ; PUNCH AN ASCII FILE ON PAPER TAPE .ENT BPUNCH ; PUNCH A BINARY FILE ON PAPER TAPE ** .DO CCOND .ENT TYPE ; TYPE FILE ON SYSTEM CONSOLE .EXTN TTOUT ; SYSTEM CONSOLE NAME ** .ENDC T **[T] .EXTN RTRN CALL ; LINKING ROUTINES .EXTN STBT LDBT ; BYTE ROUTINES .EXTN WRBIN ; WRITE BINARY ROUTINE .EXTN GETARG ;|J GET NEXT ARGUMENT .EXTN GETSW ; GET ARGUMENT SWITCHES BSIZ= 200 ICH= COMCH ** .DO CCOND OCH= PUSCH ** .ENDC J OCH= TMPCH **[J] ; DEFINE THE STACK ASWS= 1 ; /A SPACE APSW= ASWS+1 ; /B APPEND SWITCH TMP= APSW+1 ; TEMP SLOT INP= TMP+1 ; INPUT FICLENAME POINTER ONP= INP+1 ; OUPUT FILENAME POINTER BUFF= ONP+1 ; I/O BUFFER PEND= BUFF+BSIZ ; STACK SIZE ; ; MAIN XFER ROUTINE ; PEND XFER: ISZ SSRTN,2 ; SET GOOD RETURN C GETSW ; GET GLOBAL SWITCHES LDA 2,ASW ; AC2 <= /A AND 1,2 ; CHECK FOR /A` AND STA 2,ASWS,3 ; SAVE FOR LATER. LDA 2,BSW ; /B = APPEND TO EXISTING FILE AND 1,2 STA 2,APSW,3 ; SAVE FOR LATER C GETAR ; GET SOURCEFILE NAME JMP @.NOARG ; NONE THERE - ERROR SUB 1,1 ; NORMAL OPEN S OPEN ICH ; OPEN INPUT FILE JMP OPER ; ERRKOR STA 0,INP,3 ; SAVE INPUT FILE NAME POINTER C GETAR ; GET DESTINATION FILE NAME JMP @.NOARG ; NOT THERE - ERROR STA 0,ONP,3 ; KEEP OUTPUT FILENAME LDA 1,APSW,3 MOV# 1,1,SZR ; APPEND? JMP APND ; YES - .APPEND INSTEAD OF .OPEN C GETSW ; GET SWITCHES ON DESTINATION FILE LDA 3,RSW ; /R = DESTINATION RANDOM AND# 2,3,SZR ; IS IT SET ? JMP RAND ; YES- DO CREATE RANDOM LDA 2,CSW ; /C = DESTINATION CONTIGUOUS AND# 1,2,SZR ; CONTIGUOUS TRANSFER? JMP CTIG ; YES- DO CREATE CONTIGUOUS S CREA ; DEFAUL9T = SEQUENTIAL DESTINATION JMP OPER ; ERROR OPEN: SUB 1,1 ; DO NORMAL OPEN S OPEN OCH ; OPEN DESTINATION FILE JMP OPER CONT: LDA 0,.BUFD ; MAKE PTR TO READ BUFFER ADDZL 3,0 LDA 2,ASWS,3 ; AC2 <= /A MOV# 2,2,SZR ; IF THERE IS /A JMP ALOOP ; THEN XFxER IN LINE MODE. ; SEQUENTIAL I/O FOR NON-ASCII XFERS BXFER: LDA 1,NB ; MOVE N BYTES AT A TIME .LOOP: S RDS ICH ; READ 'EM JMP @.RDERR S WRS OCH ; WRITE 'EM JMP WRERR JMP .LOOP ; CONTINUE UNTIL EOF .RDERR: RDERR ; CREATE CONTIGUOUS DESTINATION FI)LE CTIG: LDA 3,USP ; RESTORE STACK POINTER LDA 0,INP,3 ; INPUT FILE NAME LDA 1,.BUFD ; BUFFER OFFSET ADD 3,1 ; MAKE BUFFER ADDR S RSTAT ; GET STATUS ON FROM FILE JMP OPER C NFBLK ; AC1 <= # BLOCKS FOR CONTIGUOUS FILE  LDA 0,ONP,3 ; RETRIEVE NAME  S CCONT ; MAKE IT JMP OPER JMP OPEN ; LINE MODE I/O FOR ASCII XFERS ALOOP: S RDL ICH ; READ A LINE JMP ARDER STA 0,TMP,3 ; SAVE BUFFER POINTER ADD 1,0 ; AC0 => LAST BYTE +1 MOVR# 0,0,SNC ; IS IT PAST A WORD BOUNDARY? JMP AWRL ; YES- NO FUDGE NEUCESSARY SUB 1,1 ; NO- PAD A NULL C STBT ; FOR MCA AWRL: LDA 0,TMP,3 ; RESTORE BUFFER POINTER S WRL OCH ; WRITE A LINE JMP WRERR JMP ALOOP ; GET NEXT LINE .NOARG: NOARG ASW: A.SW BSW: B.SW RSW: R.SW CSW: C.SW .BUFD: BUFF NB: BSIZ*2 ; CREATE RANDOM DESTINATION FILE RAND: S CRAND JMP OPER JMP OPEN ; OPEN DESTINATION FILE FOR APPENDING APND: SUB 1,1 S APPEND OCH JMP OPER JMP CONT ; HANDLE MISCELLANEOUS I/O ERRORS PARER: LDA 0,INP,3 MOV# 0,0,SKP WRERR: LDA 0,ONP,3 OPER: ER1 3 JMP RET ; NONS- FATAL ERROR JMP ERET ; FATAL ERROR ; HANDLE ASCII READ ERROR ARDER: STA 0,TMP,3 ; KEEP BUFFER PTR LDA 0,EOF SUB# 2,0,SNR ; WAS CODE EOF? JMP LLIN ; YES - WRAP IT UP MOV# 1,1,SNR ; ANY BYTES GET THROUGH? SUBZL 1,1 ; NO - GIVE ROOM TO BACK UP PTR 8 STA 1,APSW,3 ; SAVE BYTE COUNT LDA 0,INP,3 ; NO - PUT OUT ERROR MOV 2,1 ; SAVE ERROR CODE ER1 2 ; REPORT ERROR MOV 1,2,SKP ; RESTORE ERROR CODE ADC 2,2 ; HE WANTS IT FATAL LDA 0,PARITY SUB# 0,2,SZR ; PARITY ERROR? JMP ERET LDA 2,TMP,3 ; RELOA:D PTR TO BEG OF BUFFER LDA 1,APSW,3 ; RESTORE BYTE COUNT ADD 2,1 ; ADD ON BYTES ACTUALLY READ NEG 1,0 ; BACK UP ONE COM 0,0 ; NOW POINTS TO BAD CHAR LDA 1,BSLS ; STORE BACKSLASH OVER IT C STBT INC 0,0 ; CHAR AFTER SUB 1,1 ; TERMINATE LINE SO F7AR WITH NULL C STBT MOVR# 0,0,SZC ; AT WORD BOUNDARY? JMP AWRL ; YES- NO FUDGE NEEDED INC 0,0 ; NO- BUMP TO WORD BOUNDARY C STBT ; AND PAD A NULL FOR MCA JMP AWRL ; /A - JUMP INTO WRL FOR WHAT IT GOT LLIN: MOV# 1,1,SNR ; ANY BYTES READ? JMP RET ; NO- JUST RETURN LDA 0,TMP,3 ; YES- AC0 <= BUFFER POINTER ADD 1,0 ; AC0 => LAST BYTE READ+1 SUB 1,1 ; STORE A NULL FOR C STBT ; LAST BYTE MOVR# 0,0,SZC ; AT A WORD BOUNDARY? JMP MCOKL ; YES- NO FUDGE NEEDED INC 0,0 ; NO- BUMP TO WORD BOUNDARY $C STBT ; AND PAD A NULL FOR MCA MCOKL: LDA 0,TMP,3 S WRL OCH JMP WRERR JMP RET ; NOT ENOUGH ARGUMENTS ERROR NOARG: LDA 2,NOARM ; ERROR CODE ER2 3 ; REPORT ERROR JMP RET ; NORMAL RETURN ; TAKE APPROPRIATE RETURN TO CALLER ERET: LDA 2,SSOSP,3 ; cRECOVER OLD STACK POINTER DSZ SSRTN,2 ; SET FOR ERROR RETURN RET: S CLOS ICH ; CLOSE INPUT FILE NOP S CLOS OCH ; CLOSE OUTPUT FILE NOP RTRN ; TAKE APPROPRIATE RETURN ; HANDLE BINARY READ ERROR RDERR: STA 0,TMP,3 ; ERROR ON RDS LDA 0,EOF ; EOF ERROtR CODE SUB# 2,0,SZR ; THAT IT ? JMP PARER ; NO - CHECK FOR PARITY BUT DONT WRITE MOVR# 1,1,SNC ; ODD BYTE COUNT? JMP MCOKS ; NO- ALL IS WELL MOV 1,2 ; AC2 <= PARTIAL READ COUNT LDA 0,TMP,3 ; PICK UP BUFFER POINTER ADD 1,0 ; AC0 => LAST BYTE READ +&1 SUB 1,1 ; PAD A BYTE C STBT ; FOR MCA MOV 2,1 ; RESTORE PARTIAL READ COUNT MCOKS: LDA 0,TMP,3 S WRS OCH JMP WRERR JMP RET EOF: EREOF ICHD: ICH OCHD: OCH BSLS: "\ PARITY: ERPAR NOARM: CNEAR ** .DO CCOND TTOP: TTOUT ** .ENDC ; ; NFBLK- ; ROUTINcE TO CALCULATE THE NUMBER OF FULL (400 OCTAL WRDS/BLOCK) ; BLOCKS NEEDED TO ACCOMMODATE ANY RANDOM, CONTIGUOUS OR ; SEQUENTIAL FILE. ; ; ON INPUT, AC1 => UFD OF INPUT FILE FOR SIZING ; C NFBLK ; ; ON RETURN, AC1 <= # OF FULL BLOCKS. ; 0 NFBLK: MOV 1,12 ; AC2 => UFD LDA 0,UFTBC,2 ; # BYTES IN LAST BLOCK IN INPUT FILE LDA 1,UFTBK,2 ; # OF LAST BLOCK IN INPUT FILE LDA 2,UFTP2,2 ; # DATA WORDS/BLOCK IN INPUT FILE MOVZL 2,2 ; # NUMBER BYTES/BLOCK IN INPUT FILE LDA 3,CM16 ; LOOP 16 X FOR DP MULTIPLY MU&LLP: MOVR 1,1,SNC ; CHECK FOR NEXT MULTIPLIER BIT MOVR 0,0,SKP ; IF = 0, THEN JUST SHIFT ADDZR 2,0 ; IF = 1, THEN ADD AND SHFIT INC 3,3,SZR ; DONE YET ? JMP MULLP ; NO- KEEP GOING MOVCR 1,1 ; ACCOUNT FOR LAST ONE ; AC0 = HIGH ORDER, AC1 = LOW ORDER D{P # BYTES IN FILE ; DIVIDE BY 512 TO FORM SINGLE PRECISION # BLOCKS SUB 2,2 ; INITIALIZE REMAINDER FLAG LDA 3,CM9 ; LOOP 9 X FOR DP BYTES/512 DIVLP: MOVZR 0,0 ; SHIFT HIGH ORDER MOVR 1,1,SZC ; SHIFT LOW ORDER, CHECK CARRY INC 2,2 ; FLAG REMAINDER IF CARRY INC 3,3,SZR ; DONE YET ? JMP DIVLP ; NO- KEEP GOING SEQZ 2 ; IF THERE IS A REMAINDER INC 1,1 ; BUMP NUMBER OF BLOCKS. LDA 3,USP ; RECOVER STACK POINTER LDA 2,SSOSP,3 ; RECOVER OLD STACK POINTER STA 1,SSAC1,2 ; RETURN # TO CALLER RTRN ; BYE !! CM16: -16. CM9: -9. ; ; SPECIFIC OUTPUT ROUTINES ; ; DEFINE THE STACK TEMP= 1 DEVP= TEMP+1 ; DEVICE POINTER SWP= DEVP+1 ; SWITCHES SWP1= SWP+1 BUFFP= SWP1+1 ; BUFFER POINTER BUFX= BUFFP+1 ; BUFFER STSIX= BUFX+50 ; STACK SIZE ** .DO CCOND c; PRINT A FILE ON LINE PRINTER ($LPT) ** .ENDC T ; PRINT A FILE ON SYSOUT **[T] STSIX ** .DO BCOND PRINT: LDA 1,SOUTP ; USE SYSOUT AS DESTINATION "DEVICE" JMP COMX ; JOIN COMMON PATH ** .ENDC T PRINT: LDA 1,LPTP ; USE $LPT AS DESTINATION DEVICE JMP COM~X ; JOIN COMMON PATH **[T] ** .DO CCOND ; TYPE A FILE TO SYSTEM CONSOLE STSIX TYPE: LDA 1,TTOP ; USE $TTO/$TTO1 MOVZL 1,1 ; AS DESTINATION DEVICE. JMP COMX ; JOIN COMMON PATH ** .ENDC ; PUNCH AN ASCII FILE STSIX PUNCH: LDA 1,PTPP ; USE $PTP COMX: STA 1,DEVP,3 ; AS DESTINATION DEVICE. LDA 1,ABSWP ; GLOBAL /A/B GLOBAL SWITCHES STA 1,SWP,3 ; BECAUSE DEST. FILE ALREADY EXISTS. JMP COMXX ; JOIN COMMON PATH ; PUNCH A BINARY FILE STSIX BPUNCH: LDA 1,PTPP ; USE $PTP STA 1,DEVP,3 ; AS DESTINATION DEVI`CE. LDA 1,ZP ; NO GLOBAL SWITCHES STA 1,SWP,3 ; FOR BINARY XFER. COMXX: ISZ SSRTN,2 ; SET NORMAL RETURN BPT BUFX BUFFP ; BUILD POINTER TO BUFFER LDA 1,ZP ; NO SWITCHES IN STA 1,SWP1,3 ; SECOND GLOBAL SWITCH WORD. LOOPX: C GETARG ; AC0 <= POINTER T"O ARGUMENT ** .DO BCOND JMP RT ; NONE- RETURN ** .ENDC J RTRN ; NONE- RETURN **[J] MOV 0,2 ; AC2 => ARGUMENT LDA 0,LINPX ; AC0 => FORMAT LINE LDA 1,BUFFP,3 ; AC1 => COMMAND LINE BUFFER C WRBIN ; WRITE COMMAND LINE TO BUFFER 4*400+SWP ; GLOBAL SWITCHES SSAC2 ; SOURCE FILE NAME 4*400+SWP1 ; LOCAL SWITCHES DEVP ; DESTINATION FILENAME 4*400+SWP1 ; LOCAL SWITCHES MOV 1,0 ; AC0 => XFER COMMAND LINE STA 2,TEMP,3 ; SAVE POINTER FOR NEXT ARGUMENT ** .DO BCOND S CLOS SOUT ; CLOSE SYSOUT IN CASE !PRINT NOP ** .ENDC C XFER ; GO TO TRANSFER ROUTINE ** .DO CCOND NOP ; IGNORE ERROR RETURN ** .ENDC J JMP XFERR ; SOME TYPE OF ERROR **[J] LDA 0,TEMP,3 ; RESTORE ARGUMENT POINTER JMP LOOPX ; AND LOOK FOR MORE ** .DO BCOND XFERR: LDA 0,TEMP,3 ; RESTORE ARGUMENT POINTER LDA 2,.ERNUL ; REAL ERROR ALREADY REPORTED ER1 4 ; TEST ERROR OPTION JMP LOOPX ; NON-FATAL - CONTINUE LDA 2,SSOSP,3 ; FATAL- RESTORE OLD STACK POINTER DSZ SSRTN,2 ; AND SET FOR FATAL RETURN RT: LDA 0,SOUTP ; POINTER TO "SYSOUT" LDA 1,NOFF ; NO FORM FEED S APPEND SOUT ; RE-OPEN SYSOUT NOP ; MIGHT ALREADY BE OPEN RTRN .ERNUL: ERNUL NOFF: DCFFO SOUTP: .+1*2 ** .NOLOC 1 .TXT *SYSOUT* ** .NOLOC 0 ** .ENDC ABSWP: .+1*2 A.SW!B.SW 0 ZP: .+1*2 0 0 ** .NOLOC 1 ** .DO CCOND LPTP: `.+1*2 .TXT *$LPT* ** .ENDC PTPP: .+1*2 .TXT *$PTP* LINPX: .+1*2 ** .TXTN 1 ; NEED CLI "EOF" FOLLOWING IMMEDIATELY .TXT *XFER^0^F^C^0^F^C^0^F* 377*400 ** .TXTN 0 ** .NOLOC 0 ASCD.SR5 H ; ; ; ROUTINE TO CONVERT ASCII DECIMAL TO BINARY ; ; INPUT: ; ; AC0 - BYTE POINTER TO ASCII STRING TERMINATED BY DASH, ; NULL OR CARRIAGE RETURN. ; ; OUTPUT: ; ; AC1 - CONVERTED BINARY VALUE ; CONDITIONAL RETURNS- ; CALLING LOC. +1 => OVERFLOW OR% ILLEGAL CHARACTER ; CALLING LOC. + 2 => NORMAL RETURN ; ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CASCD .RB CASCD.RB ** .ENDC J .TITL BASCD .RB BASCD.RB **[J] .NREL E.TXTM 1 ; PACK EM LEFT TO RIGHT .ENT .ASCDB .EXTN CALL,LDBT,RTRN NUMB= 1 BPTR= NUMB+1 PEND= BPTR PEND .ASCDB: SUB 2,2 ; NUMBER IS ZERO TO START STA 0,BPTR,3 ; STORE BYTE POINTER .LP: STA 2,NUMB,3 ; STORE NUMBER C LDBT ; GET A BYTE LDA 0,DASyH ; IF "- THEN QUIT SUB# 0,1,SZR MOV# 1,1,SNR ; IF NULL - JMP .FIN LDA 0,ASCCR ; (OR CARRIAGE RETURN) SUB# 1,0,SNR JMP .FIN ; THEN QUIT ISZ BPTR,3 ; INC BYTE POINTER LDA 0,C60 ; LOOK FOR LEGAL CHARACTER LDA 2,C71 ADCZ# 2,1,SNC ; SKIP IF >9 ADCZ/~# 1,0,SZC ; SKIP IF >= 0 JMP ERR SUB 0,1 ; REDUCE TO OCTAL VALUE LDA 2,NUMB,3 ; RUNNING SUM WORD MOVZL 2,0,SNC ; MULTIPLY BY 10, CHECKING FOR OVER- MOVZL 0,0,SZC ; FLOW ALONG THE WAY JMP ERR ADD 0,2,SNC MOVZL 2,2,SZC JMP ERR ADD 1,2 ; ADD THIS .CHARACTER, RESTORE AC0 LDA 0,BPTR,3 ; FOR THE CALL, AND CONTINUE JMP .LP .FIN: LDA 3,SSOSP,3 ; STORE VALUE IN CALLER'S AC1 STA 2,SSAC1,3 ; AND RETURN ISZ SSRTN,3 RTRN C71: 71 C60: 60 ASCCR: 15 ; ASCII CARRIAGE RETURN .CILNA: CILNA DASH: "- ERR: LDE/A 2,.CILNA ; AC2 = ERROR CODE LDA 3,SSOSP,3 STA 2,SSAC2,3 RTRN FILCOM.SR5 V1 ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CFILCOM .RB CFILCOM.RB ** .ENDC J .TITL BFILCOM .RB BFILCOM.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT  .ENT FILCOM .EXTN CALL,RTRN,ERR1,ERR2,TIMR .EXTN GETARG,GETSW,WRLCH,STBT,MKFLA ; COMPARE (TWO) FILES WORD BY WORD ; UNMATCHED WORDS OUTPUT TO DESIGNATED FILE OR $TTO ; COMMAND: FILCOM FILE1 FILE2 [OUTPUTFILE/L] ; AC0 -> COMMAND STRING FCH1= COMCH ; FILE 1 INPUT CHANNEftL ** .DO CCOND FCH2= PUSCH ; FILE 2 INPUT CHANNEL ** .ENDC J FCH2= TMPCH ; OUTPUT CHANNEL **[J] OCH= CH1 ; OUTPUT CHANNEL BFSIZ=200 ; BUFFER SIZE ARG1=1 ; PTR TO FIRST FILENAME IN CMDLINE ARG2=ARG1+1 ; SECOND FILENAME ARGP=ARG2+1 ; MOVING ARG NAMEm PTR LOC=ARGP+1 ; FILE LOCATION COUNTER LOC1=LOC+1 BF=LOC1+1 ; BUFFER ADDR FOR LEFTOVER FILE BF1=BF+1 ; RUNNING BUFFER ADDRESS, FILE 1 BF2=BF1+1 ; " ,FILE 2 WC=BF2+1 ; WORD COUNT FOR COMPARE WC1=WC+1 ; FIRST FILE INITIAL BYTE COUNT READ WC2=WC1+1 ; SECOND FILE " DONE=WC2+1 ; EOF SEEN WORD TMP=DONE+1 ; TEMPORARY TMP1=TMP+1 ; ANOTHER TEMPORARY CHAN=TMP1+1 ; OUTPUT CHANNEL# BP1=CHAN+1 ; PTR TO FIRST BUFFER BP2=BP1+1 ; PTR TO SECOND BUFFER BUF1=BP2+1 ; FIRST FILE DATA BUFFER BUF2=BUF1+BFSIZ ; SEڒCONND FILE DATA BUFFER STSIZ=BUF2+BFSIZ STSIZ FILCOM: ISZ SSRTN,2 LDA 1,ARGD ADD 3,1 ; MOVING ADDR FOR FILENAMES STA 1,ARGP,3 ; BEGINNING WITH FIRST SPACE LDA 1,BP1D ADDZL 3,1 ; PTR TO 1ST BUFFER STA 1,BP1,3 LDA 1,BP2D ADDZL 3,1 ; PTR TO 2ND BUFFER STA 1,BP2,3 LDA 1,TTYD STA 1,CHAN,3 ; DEFAULT TO $TTO CHANNEL# SUB 1,1 STA 1,LOC,3 ; INITIALIZE LOCATION COUNTER STA 1,LOC1,3 STA 1,DONE,3 ; NO EOFS SEEN YET INCOL 1,1 ; GENERATE 3 STA 1,TMP,3 ; COUNT 3 FILES GETFL: C GETARG ; GET THE FILEmNAMES JMP NOARG C GETSW ; SWITCHES LDA 2,LSW AND# 1,2,SZR ; /L SET? JMP DEV ; YES - REPLACE DEFAULT OUTPUT FILE STA 0,@ARGP,3 ; KEEP FILENAME PTR ISZ ARGP,3 ; BUMP TO NEXT SPACE NXT: DSZ TMP,3 ; COUNT FILES GONE BY JMP GETFL OPN: LDA 0,ARG1,3 ; \FFIRST FILENAME S ROPEN FCH1 ; OPEN FOR READING JMP @OPAD LDA 2,DONE,3 LDA 0,ARG2,3 ; SECOND FILENAME S ROPEN FCH2 JMP @OPAD LDA 1,CHAN,3 ; SEND OUT HEADER MOVZR# 1,1,SNR ; $LPT ?  JMP START ; NO DON'T WANT HEADER LDA 0,HMESS C WRLCH ARG1 ; FI4RST FILE NAME ARG2 ; SECOND FILE NAME C TIMR ; PUT OUT DATE TIME JMP START DEV: SUB 1,1 ; NORMAL OPEN MOV 0,2 C MKFLA JMP @OPAD S APPE OCH JMP @OPAD LDA 1,OCHD ; NEW OUTPUT CHANNEL# STA 1,CHAN,3 JMP NXT ; CONTINUE WITH COMMAND NOARG: DSZ TMP,3 ; CHECK NO. OF FILES SEEN JMP .+2 ; IF 2 IGNORE ERROR JMP OPN LDA 2,NORG ; NOT 2 ER2 4 NOP JMP @ERETD ; REPORT AND STOP HMESS: HEDR*2 ; HEADER MESSAGE LSW: 1B11 NORG: CNEAR ARGD: ARG1 BP1D: BUF1 BP2D: BUF2 TTYD: 1 OPAD: OPER ERETD: ERET ** .$DO BCOND SYSD: 1 ** .ENDC REFIL: SUB 1,1 ; INITIAL BYTE COUNT LDA 2,WC1,3 ; FILE 1 ONLY POSSIBILITY FOR REMAINDER MOV# 2,2,SZR ; ANY REMAINDER BEYOND LENGTH OF 2? JMP FIN1 ; YES - PUT IT OUT LDA 2,DONE,3 ; CHECK DONE WORD MOVL# 2,2,SZC ; FIRST FILEW EOF SEEN? JMP SK1ST ; SKIP THE FIRST ONE START: LDA 1,BFSZ ; BYTES TO READ LDA 0,BP1,3 ; FIRST BUF PTR S RDS FCH1 ; NEW BLOCK OF DATA FROM FILE 1 JMP TRAP1 RF1: STA 1,WC1,3 ; ACTUAL COUNT READ MOVZR 0,0 ; CHANGE PTR TO ADDRESS STA 0,BF1,3 ; REINITIALIZE RUNNING ADDRESS SK1ST: MOVR# 2,2,SZC JMP RF3 ; SECOND FILE EOF SEEN MOV# 1,1,SNR ; ANYTHING ACTUALLY READ? LDA 1,BFSZ ; NO - RELOAD BUFFERSIZE LDA 0,BP2,3 ; ELSE SAME NUMBER READ FOR FILE 2 S RDS FCH2 ; NEW DATA FOR FILE 2 JMP TRAP2 RF2: STA 1ds,WC2,3 ; ACTUAL READ COUNT MOVZR 0,0 ; ADDRESS TOP OF BUFFER STA 0,BF2,3 ; RESET EACH READ RF3: MOVZR 1,2 ; CHANGE BYTE TO WORD COUNT STA 2,WC,3 ; SAVE TO COMPARE THAT MANY WCCK: LDA 2,WC1,3 ; CHECK BYTE COUNTS SUB# 1,2,SZR ; EQUAL? JMP NEQ ; NO MO$V# 1,1,SNR ; EQUAL JMP @.ALDON ; BOTH ZERO - STOP JMP RSWC ; BOTH NONZERO - KEEP GOING NEQ: MOV# 2,2,SNR ; NOT EQUAL - EITHER ZERO? JMP FIN2 ; FIRST IS ZERO MOV# 1,1,SNR JMP FIN1 ; SECOND IS ZERO SUBZ 1,2,SNC ; UNEQUAL BUT NEITHER ZERO RSWC: SUB 2,2 1D ; RESET WORD COUNTS STA 2,WC1,3 ; IF FIRST LARGER KEEP REMAINDER SUB 1,1 STA 1,WC2,3 COMPR: LDA 0,@BF1,3 ; WORD FROM FIRST FILE LDA 1,@BF2,3 ; SECOND FILE ISZ BF1,3 ; BUMP BUFFER ADDRESSES ISZ BF2,3 SUB# 0,1,SZR ; MATCH WORDS JMP NOMAT ; THEY DO}NT COM1: ISZ LOC1,3 JMP .+2 ISZ LOC,3 ; NEXT FILE LOCATION DSZ WC,3 ; COUNT WORDS IN BUFFER JMP COMPR JMP REFIL ; FINISHED THIS ONE BFSZ: BFSIZ*2 OCHD: OCH .ALDON: ALDON NOMAT: STA 0,TMP,3 ; FIX IN STACK STA 1,TMP1,3 LDA 1,CHAN,3 ; OUTPUT CHANNEL V LDA 0,FLIN ; FORMAT LINE C WRLCH LOC LOC1 TMP TMP1 JMP COM1 ; GO FOR NEXT WORD PAIR TRAP1: SUBZR 0,0,SKP ; 1B0 FILE 1 TRAP2: SUBZL 0,0 ; 1B15 FILE 2 STA 1,TMP,3 ; KEEP PARTIAL COUNT LDA 1,EOFC SUB# 1,2,SZR ; WAS ERROR EOF? JMP RDER ; NO - ERROGR OUT LDA 2,DONE,3 ; YES - SET APPROPRIATE DONE BIT ADD 0,2 STA 2,DONE,3 MOVR 0,0,SNC ; SET CARRY IF FILE 2 JMP .+3 LDA 0,BP2,3 ; FILE 2 JMP .+2 LDA 0,BP1,3 ; FILE 1 LDA 1,TMP,3 ; RECOVER PARTIAL COUNT MOVR# 1,1,SNC ; EVEN NO. OF BYTES? JMP TRX W ; YES ISZ TMP,3 ; NO - ADD A BYTE ADD 1,0 ; MAKE PTR TO BYTE POSITION SUBC 1,1 ; KEEP CARRY INTACT C STBT ; FILL OUT WORD WITH NULL BYTE LDA 1,TMP,3 ; BYTE COUNT AGAIN SUBC 1,0 ; BACK TO ORIGINAL PTR INC 0,0 ; CORRECT FOR EVEN BYTE TRX: MOV# 0,0s:,SZC ; RESUME JMP RF2 JMP RF1 FIN1: MOV 2,1 LDA 2,CH1D ; FILE 1 CHANNEL# STA 2,TMP,3 LDA 2,BF1,3 ; BUFFER ADDRESS LDA 0,FORM1 ; FORMAT FOR FILE 1 ONLY JMP FIN3 FIN2: LDA 2,CH2D ; FILE 2 CHANNEL# STA 2,TMP,3 LDA 2,BF2,3 ; BUF ADDRESS LDA 0,FORM2 FIN3: STA 0,TMP1,3 ; KEEP PROPER FORMAT PTR MOVZR 1,1 STA 1,WC,3 ; WORD COUNT STA 2,BF,3 ; REINITIALIZE BUF ADDR LDA 1,CHAN,3 ; OUTPUT CHANNEL# FLOOP: LDA 2,@BF,3 ; DATA WORD ISZ BF,3 ; BUMP TO NEXT BUF ADDR C WRLCH LOC LOC1 SSAC2 ISZ LOC1,3 ; }NEXT LOCATION JMP .+2 ISZ LOC,3 DSZ WC,3 JMP FLOOP LDA 0,BP1,3 ; USE 1ST FILE BUF FOR SUCCESSIVE READS LDA 1,BFSZ ; NEW BYTE COUNT LDA 2,TMP,3 ; CHANNEL# FOR REMAINING FILE S RDS CPU ; TRY FOR MORE JMP TRAP FL1: MOVZR 0,2 ; BUF PTR TO ADDRESS LDA 0,TMP1,3 ; GET FILES FORMAT PTR JMP FIN3 EOFC: EREOF CH1D: FCH1 CH2D: FCH2 TRAP: LDA 0,EOFC SUB# 0,2,SZR ; END OF FILE? JMP RDER1 ; NO - ERROR OUT MOV# 1,1,SNR JMP ALDON ; ZERO BYTE COUNT LDA 0,BP1,3 MOV 1,2,SNC ; CHECK BYTES AND MOVE OUT OF WAY JMP FL1 ; ALREADY EVEN NO. OF BYTES ADD 1,0 ; PTR TO EXTRA BYTE SUB 1,1 C STBT ; FILL OUT WITH NULL INC 2,1 ; MAKE BYTE COUNT NEXT EVEN WORD JMP FL1 RDER1: LDA 0,TMP,3 ; READ ERROR, ONE FILE FINISHING LDA 1,CH1D ; CHANNEL FILE 1 SUB# 1,0,SNR ; FIND WHO THIS IS JMP F1 JMP F2 RDER: MOVL# 0,0,SNC ; READ ERROR, BOTH FILES STILL GOING JMP .+3 F1: LDA 0,ARG1,3 ; GET APPROPRIATE FILENAME JMP .+2 F2: LDA 0,ARG2,3 OPER: ER1 3 JMP ALDON ERET: LDA 2,SSOSP,3 DSZ SSRTN,2 ALDON: S CLOS FCH1 JMP .+1 S CLOS FCH2 JMP .+1 LDA 1,CHAN,3 ; OPTIONAL OUTPUT CHANNEL? LDA 0,OCHD SUB# 0,1,SZR RTRN ; NO - LEAVE $TTO OPEN S CLOS OCH JMP .+1 RTRN ** .NOLOC 1 FLIN: .+1*2 .TXT "^Q^B<8.>/ ^O^Z<6> ^O^Z<6><15>" FORM1: .+1*2 .TXT "^Q^B<8.>/ ^O^Z<6> ---<n715>" FORM2: .+1*2 .TXT "^Q^B<8.>/ --- ^O^Z<6><15>" HEDR: .TXT *FILCOM ^C ^C^T<70>* ** .NOLOC 0 .END INSEF.SR5  ; ; INSEF- ; OPEN/READ/CLOSE INSERT FILE WHOSE NAME IS POINTED ; TO BY AC0, IN BUFFER POINTED TO BY AC2, ; INTO BUFFER POINTER TO BY AC2. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .=TITL CINSEF .RB CINSEF.RB ** .ENDC J .TITL BINSEF .RB BINSEF.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT INSEF ; ENTRY POINT .ENTO LINEX ; OVERLAY NODE/NUMBER .EXTN GCBUF ; GET CHARACTER FROM BUFFER .EXTN PUSHB ; PUSH BUFFER STATE .EX/#TN RDLIN ; READ LINE TO BUFFER ROUTINE .EXTN GETCR ; GET COMMAND RESULT .EXTN STBT ; STORE A BYTE .EXTN LDBT ; LOAD A BYTE .EXTN CMDER ; COMMAND ERROR VECTOR .EXTN CALL RTRN ; LINKING ROUTINES ;DEFINE THE STACK BUFR= 1 ; ADDRESS OF BUFFER NAMP=  INPUT STRING mLDA 2,BUFR,3 ; AC2 => BUFFER C GETCR ; GET COMMAND RESULT STA 1,INPT,3 ; UPDATE INPUT POINTER INECL: LOADB CRBPT ; GET COMMAND RESULT BYTE MOV# 1,1,SNR ; IS IT A NULL? JMP INSE1 ; YES- REJOIN INPUT LOOP STORB TMP ; NO- STORE BYTE IN NAME SPACE DSZ CNT,3 ; HAS CHAR LIMIT BEEN REACHED? JMP INECL ; NO- LOOK AT NEXT RESULT BYTE JMP INER1 ; YES- GO SEND ERROR INEON: SUB 1,1 ; STORE TERMINATOR STORB TMP LDA 0,NAMP,3 ; OPEN THE FILE INC 0,0 ; BUMP PAST ATT S OPEN INSCH ; ON INSERT CHANNEL JMP ER1{X ; GIVE ERROR AND BOMB OUT LDA 2,BUFR,3 ; AC2 => BUFFER HEADER LDA 0,INPT,3 ; AC0 => NEXT CHARACTER C GCBUF ; GET NEXT CHARACTER LDA 0,INEOT ; IF CHARACTER IS SUB# 0,1,SZR ; NOT EOT THEN JMP INPSH ; PUSH BUFFER STATE LDA 0,BFRPT,2 ; ELSE RESET ST5ART STA 0,BFFFB,2 ; OF BUFFER FRAME JMP INEO0 ; AND INSERT FILE. INPSH: LDA 1,INPT,3 ; AC1 <= INPUT POINTER C PUSHB ; PUSH BUFFER STATE INEO0: LDA 1,.INSCH ; AC1 = CHANNEL NUMBER INEO1: C RDLIN ; READ A LINE INTO JMP INEO2 ; END OF FILE - CLOSE AND RETURN JMP INEO1 ; READ ANOTHER LINE INEO2: S CLOS INSCH ; CLOSE THE CHANNEL NOP RTRN ; ERROR HANDLING INERR: STORB TMP ; STORE THE BAD CHARACTER INER1: SUB 1,1 ; AND A TERMINATING STORB TMP ; NULL LDA 0,NAMP,3 ; PICK UP POINTER TO INPUTTED STRING} LDA 2,.CINDE ; PICK UP ERROR CODE ER1X: ER1 ; REPORT ERROR JMP @.+1 CMDER ; BOMB OUT .CINDE: CINDE KNCHAR: (NULL-NAME)*2 .INSCH: INSCH WRLIN.SR5 I5 ; ; OUTPUT FORMAT ROUTINE. ; AC0 POINTS (BYTE POINTER) TO THE INPUT STRING(ENDS WITH NULL) ; IF ENTRY AT WRLINE, OUTPUT LINE IS WRITTEN ON CHANNEL 1. ; IF ENTRY AT WRLCH, AC1 <= CHANNEL NUMBER. ; IF ENTRY AT WRBIN, AC1 <= CHANNEL NUMBER, OR IF ; CHANNEL NUMBER >7, IT IS INTERPRETED TO BE A ; BYTE POINTER TO AN OUTPUT BUFFER. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CWRLIN .RB CWRLIN.RB ** .ENDC J .TITL BWRLIN .RB BWRLIN.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT WRLINE ; WRITE LINE TO CHANNEL 1 .ENT WRLCH ; WRITE LINE TO SPECIFIED CHANNEL .ENT WRBIN ; WRITE BINARY TO CHANNEL/ ; FORMAT LINE TO BUFFER .EXTN CALL LDBT STBT RTRN BSPAD BSPAO BSPAH .EXTN FSERR CMOVE BDPAD BDPAO .EXTN .INDEX ** .DO CCOND ; CLI CONDITIONAL .EXTN LOGER CLIRS .EXTN TTOUT ** .ENDC T .EXTN RESET ** [T] ; DEFINE THE STACK IP= 1 ; INPUT POINTER OP= IP+1 ; RUNNING OUTPUT POINTER TP= OP+1 ; TABLE POINTER SP= TPZ+1 ; START OF BUFFER POINTER ENTSW= SP+1 ; ENTRY POINT SWITCH BFSW= ENTSW+1 ; BINARY OUTPUT/FORMAT SWITCH CHAN= BFSW+1 ; CHANNEL FOR OUTPUT OCHAR= CHAN+1 ; CHARS OUTTED BY CONV ROUTINES KIND= OCHAR+1 ; TYPE OF FILL OOP= KIND+1 ; TEMP LINE PTR NUMCH=5 OOP+1 ; NUM OF CHARS TO SHUFFLE PENDP= NUMCH+1 ; POINTER TO END OF OUTPUT BUFFER TMP= PENDP+1 ; OUTPUT BUFFER PEND= TMP+(SCLLG/2) ; STACK SIZE PEND WRLINE: SUBZL 1,1,SKP ; SET CHANNEL = 1 PEND WRLCH: STA 1,CHAN,3 ; SET CHANNEL NUMBER SUBZR 1,1 ; SET ENTRY POINT SWITCH STA 1,ENTSW,3 ; = 1B0 FOR WRLINE/WRLCH WCOM: STA 0,IP,3 ; SAVE INPUT BYTE PTR BPT TMP OP ; MAKE OUTPUT BYTE POINTER STA 1,SP,3 BPT PEND PENDP ; MAKE POINTER TO END OF OUTPUT BUFFER LOOP: LDA 0,IP,3 ; PICK UP CURRENT POINTER 6C LDBT ; LOOK AT NEXT BYTE ISZ IP,3 ; BUMP INPUT POINTER LDA 2,UPAR ; SEE IF ITS UP ARROW SUB# 2,1,SNR ; IF THIS IS AN ARROW JMP ESC ; GO DO SPECIAL PROCESSING LDA 0,OP,3 ; ELSE PICK UP OUTPUT POINTER C STBT ; AND STORE BYTE. ISZ OP,3 ; BUMP OUTPNUT POINTER MOV# 1,1,SNR ; WAS CHAR A NULL? JMP DONE ; YES- WE ARE DONE LPEND: LDA 1,ENTSW,3 ; AC1 <= ENTRY SWITCH MOV# 1,1,SZR ; IF ENTRY WAS AT WRLINE/WRLCH JMP CKEND ; THEN CHECK IF WE ARE AT END OF BUFFER LDA 1,BFSW,3 ; ELSE ENTRY WAS AT WRBIN. LDc)A 2,C7 ; AC2 = HIGHEST CHANNEL NUMBER SUBZ# 1,2,SNC ; IF BFSW > 7 WE ARE FORMATTING JMP LOOP ; OUTPUT INTO AN EXTERNAL BUFFER. CKEND: LDA 1,PENDP,3 ; AC1 => 133RD BYTE IN BUFFER ADCZ# 0,1,SZC ; IF < 133 CHARS HAVE BEEN PUT JMP LOOP ; IN TMP BUFFER, KE`EP PROCESSING DONE: LDA 0,SP,3 ; END REACHED- DO OUTPUT LDA 1,ENTSW,3 ; AC1 <= ENTRY POINT SWITCH MOVL# 1,1,SNC ; IS 1B0 SET ? JMP BOUT ; NO- DO BINARY OUTPUT/FORMAT LDA 2,CHAN,3 ; AC2 <= CHANNEL NUMBER S WRL CPU ; OUTPUT THE STRING JMP DOT ; FATAL OUTPUT ERROR ** .DO CCOND ; CLI COND MOVZR# 2,2,SZR ; IS THIS WRLIN OR WRLCH? RTRN ; SKIP FOR WRLCH LOG ; LOG IF NECESSARY ** .ENDC RTRN ** .DO CCOND ; CLI CONDITIONAL DOT: LDA 2,BPFAT ; GIVE FATAL ERROR JMP @.CLIRS BPFAT: FATER*2 .CLIRS: CLIRS **0 .ENDC T DOT: LDA 0,.SYSO ; KEEP MOVING IF BATCH LDA 1,NOFF S APPEN SOUT JMP .+1 LDA 2,CHAN,3 LDA 0,SP,3 S WRL CPU JMP @.RSET RTRN ** [T] UPAR: "^ ; ; ENTER HERE FOR BINARY OUTPUT/FORMAT LINE INTO EXTERNAL BUFFER ; PEND WRBIN: SUB 2,2 ; SET EcNTRY POINT SWITCH STA 2,ENTSW,3 ; = 0. STA 1,BFSW,3 ; SET BINARY OUTPUT/FORMAT SWITCH LDA 2,C7 SUBZ# 1,2,SZC ; IF CHANNEL NUMBER .LE. 7 JMP WCOM ; THEN DO BINARY OUTPUT ELSE STA 1,OP,3 ; AC1 IS BUFFER POINTER, STA 0,IP,3 ; AC0 IS THE INPUT POINTE-oR JMP LOOP ; AND JUST FORMAT OUTPUT. BOUT: DSZ OP,3 ; DO BINARY OUTPUT LDA 1,OP,3 SUB 0,1 ; AC1 GETS # BYTES LDA 2,BFSW,3 ; PICK UP CHANNEL NUMBER- LDA 3,C7 ; IF CHANNEL SWITCH > 7 SUBZ# 2,3,SNC ; THEN RTRN ; RETURN ELSE S WRS CPU ; DO .WRS JMP ERR LDA 3,SSOSP,3 ISZ SSRTN,3 RTRN ERR: LDA 3,SSOSP,3 ; ERROR ON WRS STA 2,SSAC2,3 RTRN ** .DO BCOND ; BATCH COND .RSET: RESET .SYSO: .+1*2 .TXT /SYSOUT/ NOFF: 1B3 ** .ENDC C7: 7 ; FOUND AN UP ARROW, DO SPECIAL PROCESSING ESC: LDA 0,IP,3 ;- LOOK AT NEXT CHAR C LDBT ISZ IP,3 ; ADJUST INPUT POINTER LDA 2,TAB ; PICK UP TABLE POINTER STA 2,TP,3 ; SAVE IN STACK ESC1: LDA @2,TP,3 ; LOAD A CHAR ISZ TP,3 ; BUMP TABLE POINTER COM# 2,2,SNR ; IS THIS END OF TABLE? JMP LOOP ; YES- IGNORE SPECIAL WCHARACTER SUB# 2,1,SNR ; IS THIS THE ENTRY? JMP ESC2 ; YES- GO GET ARGUMENT ISZ TP,3 ; NO- BUMP TABLE POINTER JMP ESC1 ; GO LOOK AT NEXT ENTRY ESC2: LDA 2,SSOSP,3 ; AC2 GETS CALLER'S STACK POINTER LDA @0,SSRTN,2 ; AC0 GETS ARGUMENT ISZ SSRTN,2 ; BUMP7 CALLER'S RETURN PAST ARGUMENT JMP @TP,3 ; GO DO SPECIAL PROCESSING TAB: .+1 ; SPECIAL PROCESSING DISPATCH TABLE "I ; IGNORE ARGUMENT JMP LOOP "P ; DOUBLE PRECISION DECIMAL JMP DPDEC "Q ; DOUBLE PRECISION OCTAL JMP DPOCT "W ; INSERT A WORD (2d CHARACTERS) JMP WORD "O ; OCTAL OUTPUT JMP OCTAL "D ; DECIMAL OUTPUT JMP DECIM "H ; HEX OUTPUT JMP HEX 0 ; STORE A ZERO JMP ZER "0 ; STORE A NULL JMP ZER1 "F ; BINARY SPECIFIED CHARACTER INSERTION JMP CBIN "B ; LEADING BLANKS JMP BINS "Z ; LEADING ZEROES JMP ZINS "T ; INSERT BLANKS JMP @.TABB "C ; INSERT CHARACTERS JMP @.CHARS "E ; INSERT ERROR MESSAGE JMP @.FSER -1 ; END OF TABLE .TABB: TABB .CHARS: CHARS .FSER: FSER ; OCTAL OUTPUT ROUTINE OCTAL: ADD 0,2 ; AC2 => AHRGUMENT LDA 1,0,2 ; LOAD ARGUMENT LDA 0,OP,3 ; OUTPUT STRING POINTER C BSPAO ; CONVERT TO OCTAL AND STORE JMP DRT ; TAKE SAME ROUTE AS DEC ; STORE A NULL/ZERO ZER1: SUB 1,1 ; AC1 <= NULL ZER: LDA 0,OP,3 ; AC0 <= OUTPUT POINTER C STBT ; STORE THE?` CHARACTER ISZ OP,3 ; BUMP THE OUTPUT POINTER DSZ SSRTN,2 ; PUSH BACK THE RETURN JMP @.LPEND ; CHECK FOR END OF BUFFER ; DECIMAL OUTPUT DECIM: ADD 0,2 ; AC2 => ARGUMENT LDA 1,0,2 ; AC1 <= NUMBER FOR CONVERSION LDA 0,OP,3 ; AC0 => OUTPUT STRING C BSPAD ; CONVERT TO ASCII DECIMAL DRT: LDA 1,OP,3 ; GET NUM CHAR OUTTED STA 0,OP,3 ; UPDATE OUTPUT POINTER MOV 0,2 ; AC2 => NULL SUB 1,2 ; GET NUM CHARS MOVED STA 2,OCHAR,3 ; SAVE EM FOR LATER JMP .RT2 ; REJOIN LOOP ; INSERT A WORD (2 CHARACTERS) WSORD: ADDZL 2,0 ; AC0 <= BYTE POINTER TO WORD LDA 2,C2 ; AC2 = 2 CHARS TO BE MOVED JMP MOVCM ; GO MOVE 'EM ; BINARY SPECIFIED CHARACTER INSERTION CBIN: LDA 1,C377 ; EXTRACT OFFSET INTO STACK OF BYTE AND 0,1 ; POINTER FROM RIGHT HALF OF ARG. ADD 1,2 ) ; AC2 => POINTER IN CALLER'S STACK MOVS 0,1 ; EXTRACT # CHARS TO BE INSERTED LDA 0,C377 ; FROM LEFT HALF OF ARGUMENT. AND 0,1 ; AC1 <= NUMBER OF CHARS FOR MOVE LDA 0,0,2 ; AC0 => STRING TO BE MOVED MOV 1,2 ; AC2 <= # CHARS FOR MOVE MOVCM: LDA 1,OP,&3 ; AC1 => OUTPUT STRING MOVEM: C CMOVE ; MOVE THE CHARACTERS .RT: MOV 1,0 ; AC0 = UPDATED OUTPUT POINTER .RT1: STA 0,OP,3 ; UPDATE OUTPUT POINTER .RT2: NEG 0,0 ; DECREMENT AC0 COM 0,0 ; FOR BUFFER END CHECK JMP @.LPEND ; GO CHECK FOR BUFFER ENDe^ C2: 2 C377: 377 .LPEND: LPEND ; DOUBLE PRECISION DECIMAL OUTPUT DPDEC: ADD 0,2 LDA 1,0,2 LDA 2,SSOSP,3 LDA @0,SSRTN,2 ISZ SSRTN,2 ADD 0,2 LDA 2,0,2 LDA 0,OP,3 C BDPAD JMP DRT ; DOUBLE PRECISION OCTAL OUTPUT DPOCT: ADD 0,2 LDA 1,0,2 LDA 2,SSOSP,3 LDA 0,@SSRTN,2 ISZ SSRTN,2 ADD 0,2 LDA 2,0,2 LDA 0,OP,3 C BDPAO JMP DRT ; HEXADECIMAL OUTPUT ROUTINE HEX: ADD 0,2 LDA 1,0,2 LDA 0,OP,3 C BSPAH JMP DRT ; LEADING ZEROES/BLANKS ZINS: SUBZL 1,1,SKP ; 1=LEADING ZEROS BINS: SUB 1,1 ; :N0=LEADING BLANKS STA 1,KIND,3 ; SAVE WHICH TYPE DSZ SSRTN,2 ; BACK UP CALL ARG PTR TO SKIP ^Z,^B S LDA 0,IP,3 ; NXT CHAR = MIN FIELD WIDTH C LDBT ; AC1 <= MINIMUM FIELD WIDTH ISZ IP,3 ; BUMP INPUT POINTER LDA 0,OCHAR,3 ; CHECK IF HAVE ENOUGH ALREADY NEG 0,2 ; SAVE COUNT FOR MOVE SUBZ 1,0,SZC JMP @.LOOP ; HAVE ENOUGH- REJOIN INPUT LOOP STA 0,NUMCH,3 ; SAVE THAT COUNT LDA 1,OP,3 ; SET MOVE PTRS STA 1,OOP,3 ; TO LAST CHAR SUB 0,1 STA 1,OP,3 ; STOW IT JMP PACK2 PACK1: LDA 0,OOP,3 C LDBT LDA 0,OP,3 ; SHUFFLE EM C STBT INC 2,2,SNR ; END OF IT ?? JMP ENDIT ; WHAT DO YU THINK PACK2: DSZ OP,3 ; DECREMENT POINTERS DSZ OOP,3 JMP PACK1 ; PLAY IT AGAIN SAM ENDIT: LDA 2,KTAB ; GET TYPE OF STUFFING LDA 1,KIND,3 ; GET TABLE DISPLACEMENT ADD 1,2 LDA 1,0,2 ; GET THE MOTHER LDA 2,NUMCH,3 ; SAVE ME I AM IMPORTANT AGN: DSZ OP,3 LDA 0,OP,3 ; TO WHERE I AM GOING C STBT ; SHOVE IT INC 2,2,SZR ; DONE ? JMP AGN ; NO TRY AGAIN LDA 0,OP,3 LDA 1,NUMCH,3 ; NOW RESET LINE PTR SUB 1,0 LDA 1,OCHAR,3 ADDu 1,0 JMP .RT1 ; REJOIN LOOP KTAB: .+1 BLANK: 40 "0 .LOOP: LOOP ; INSERT ERROR MESSAGE TEXT FSER: ADD 0,2 ; AC2 GETS => ARGUMENT LDA 0,0,2 ; AC0 GETS ERROR CODE LDA 1,OP,3 ; PUT OUTPUT POINTER IN AC1 C FSERR ; INSERT ERROR MESSAGE TEXT JMP .RT v ; REJOIN INPUT LOOP ; MOVE CHARS TO OUTPUT BUFFER (^C) CHARS: ADD 0,2 ; AC2 GETS ADDRESS OF POINTER STA 2,OOP,3 ; SAVE ADDRESS OF POINTER TO STRING LDA 0,0,2 ; AC0 => CHAR STRING SUB 1,1 ; SEARCH FOR NULL IN STRING C .INDEX ; RETURN => NULL IN AC1j NOP ; NO MATCH RETURN SUB 0,1 ; AC1 GETS LENGTH OF STRING-1 LDA 0,PENDP,3 ; PICK UP POINTER TO BUFFER'S END LDA 2,OP,3 ; PICK UP CURRENT BUFFER POINTER SUB 2,0 ; AC0 GETS BYTES REMAINING-1 INC 0,0 ; AC0 = # BYTES REMAINING SUBZ# 1,0,SNC ; IS THp+ERE ROOM FOR WHOLE STRING? JMP CHRS2 ; NO- MOVE ONLY WHAT WE HAVE ROOM FOR MOV 1,2 ; YES- MOVE THE WHOLE STRING JMP CHRS3 ; GO MOVE 'EM CHRS2: MOV 0,2 ; MOVE WHAT WE HAVE ROOM FOR CHRS3: LDA 1,OP,3 ; AC1 GETS "TO" POINTER LDA 3,OOP,3 ; RESTORE ADDRESRhS OF POINTER LDA 0,0,3 ; AC0 GETS "FROM" POINTER JMP MOVEM ; GO MOVE 'EM ; INSERT BLANKS (TAB OVER) TABB: DSZ SSRTN,2 ; NO ARG FOR THIS LDA 0,IP,3 ; INPUT STRING POINTER C LDBT ; PICK UP BYTE ISZ IP,3 ; BUMP POINTER LDA 2,SP,3 ; BEGIN OF LINE LDcA 0,OP,3 ; CURRENT POSITION SUB 2,0 ; TAB COLUMN SUBZ 0,1,SZC ; SEE WHERE WE ARE NOW NEG 1,2,SNR ; NEGATE SPACE COUNT JMP @.LOOP ; THERE OR PAST IT ALREADY LDA 0,OP,3 LDA 1,BLANK ; AC1 <= BLANK (SPACE) TABLP: C STBT ; PUT OUT BLANK INC 0,0 ; BUMP POINTER INC 2,2,SZR JMP TABLP JMP @.RT1P ; REJOIN LOOP .RT1P: .RT1 ** .DO CCOND ** .NOLOC 1 FATER: .TXT *FATAL OUTPUT ERROR<15>* ** .NOLOC 0 ** .ENDC RDLIN.SR5 _ =w ; ; RDLIN- ; READ LINE ON CHANNEL IN AC1 ; TO BUFFER IN AC2 ; SEND TO LOG FILE IF NECESSARY ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CRDLIN .RB CRDLIN.RB ** .ENDC J .TITL MBRDLIN .RB BRDLIN.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT RDLIN .EXTN LDBT CALL RTRN .EXTN PCBUF .EXTN CALL RTRN STBT LDBT .EXTN CMDER ; COMMAND ERROR ROUTINE ; DEFINE THE STACK BUFR= 1 ; ADDRESS OF BUFFER CHAN= BUFR+1 ; CHANNEGL NUMBER TMP= CHAN+1 ; BUFFER ADDRESS RBUFP= TMP+1 ; POINTER TO LINE BUFFER RBUF= RBUFP+1 ; READ LINE BUFFER NULL= RBUF+(SCLLG/2) ; NULL TERMINATOR FRAME= NULL ; FRAME SIZE FRAME RDLIN: ISZ SSRTN,2 ; ADDJUST FOR GOOD RETURN LDA 2,SSAC2,2 ; GET BUFFER POINTER STA 2,BUFR,3 ; SAVE IT STA 1,CHAN,3 ; SAVE CHANNEL BPT RBUF RBUFP ; FORM BYTE POINTER TO LINE BUFFER RDLI1: LDA 0,RBUFP,3 ; READ A LINE STA 0,TMP,3 LDA 2,CHAN,3 S RDL CPU JMP RDLER ; TAKE A DETOUR RDLIR: LDA 1,INCHAN ; AC1 <= CONSOLE IrNPUT CHANNEL LDA 2,CHAN,3 ; AC2 <= CURRENT INPUT CHANNEL SUB# 1,2,SZR ; IF THIS IS NOT CONSOLE INPUT CHANNEL JMP RDLI2 ; DO NOT ATTEMPT TO LOG ELSE LOG ; LOG IF NECESSARY. RDLI2: LOADB TMP ; GET NEXT BYTE RDLI3: DISP RDSPT ; DISPATCH ON IT RDSPT: .+1 UPAR: "^ ; CONTINUATION LINE RDUPA CARR: 15 ; END OF LINE RDEOL FFM: 14 ; END OF LINE RDEOL 0 ; READ NEXT LINE RDLI1 4 ; END OF FILE RDEOF -1 RDANY ; ANYTHING ELSE INCHAN: CIN RDANY: LDA 2,BUFR,3 ; GET BUFFER POINTER C PCBUF ; STORE CHAR IN BUFFER JMP RDLI2 ; PROCESS NEXT BYTE RDEOL: LDA 1,CARR ; ALL EOLS BECOME C/R'S LDA 2,BUFR,3 ; POINT TO BUFFER C PCBUF RTRN ; THATS IT FOLKS RDLER: LDA 3,.EREOF SUB# 3,2,SZR ; END OF FILE ?? JMP ERROR ; NO- GO REPORT THE PROBLEM ADD 81,0 ; STORE AN EOT LDA 1,EOF C STBT LDA 1,CARR ; AND A CARRIAGE RETURN FOR LOG INC 0,0 C STBT LDA 0,TMP,3 ; RESTORE POINTER FOR LOG JMP RDLIR ; THEN LOG AND SCAN LINE RDUPA: LOADB TMP ; GET NEXT CHAR LDA 0,CARR LDA 2,FFM SUB# 2,1,SZR ; FOLLOWED| BY EOL? SUB# 0,1,SNR JMP RDLI1 ; YES GET NEXT LINE MOV 1,1,SNR ; DON'T FORGET NULL JMP RDLI1 ; YES GET NEXT LINE RDUP1: MOV 1,0 ; SAVE CHARACTER LDA 1,UPAR ; STORE UP ARROW LDA 2,BUFR,3 ; IN BUFFER C PCBUF MOV 0,1 ; RESTORE THE CHARACTER JMP R}DLI3 ; DISPATCH ON IT RDEOF: LDA 2,BUFR,3 C PCBUF ; STORE END OF FILE LDA 2,SSOSP,3 ; TAKE EOF RETURN DSZ SSRTN,2 RTRN ERROR: ER2 ; REPORT THE ERROR JMP @.CMDER ; BOMB OUT .CMDER: CMDER .EREOF: EREOF EOF: EOT WFGND.SR5 ,}; ; WFGND- ; WRITE FOREGROUND STATE TO OUTPUT CONSOLE. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CWFGND .RB CWFGND.RB ** .ENDC J .TITL BWFGND .RB BWFGND.RB  **[J] .NREL .YTXTM 1 ; PACK 'EM LEFT TO RIGHT .ENT WFGND ; ENTRY POINT .EXTN CALL RTRN ; LINK ROUTINES .EXTN WRLIN ; WRITE STRING TO CHANNEL 1 0 WFGND: ISZ SSRTN,2 ; BUMP TO GOOD RETURN LDA 2,NOMSG ; INITIALIZE FOR NEGATIVE MESSAGE S FGND ; SEE IF FOREGROUND TRUNNING NOP MOV# 0,0,SZR ; FOREGROUND RUNNING? LDA 2,YEMSG ; YES- WRITE OUT AFFIRMATIVE MOV 2,0 ; PUT BYTE POINTER TO MESSAGE IN AC0 C WRLIN ; WRITE IT OUT RTRN ; THAT'S ALL! ** .NOLOC 1 YEMSG: .+1*2 .TXT *FOREGROUND PROGRAM RUNNING<15>* NOMSG: <$>.+1*2 .TXT *NO FOREGROUND PROGRAM RUNNING<15>* ** .NOLOC 0 LIS2.SR5   ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CLIS2 .RB CLIS2.RB ** .ENDC J .TITL BLIS2 .RB BLIS2.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENTO LIS2E .ENT LIS2 .E\XTN CALL RTRN .EXTN LDBT STBT GETSW ERR1 .EXTN .INDEX WRLCH .EXTN MOVE CMOVE .EXTN WRLIN WRBIN COMP .EXTN TIMR SBUFR BFMVO  LCH= COMCH ; DEVICE OUTPUT CHANNEL ** .DO CCOND SCH= PUSCH ; SYS.DR CHANNEL# TCH= CH1 ; TEMPORARY FILE CHANNEL .ENDC J SC~H= TMPCH ; SYS.DR CHANNEL# TCH= CH1 ; TEMPORARY FILE CHANNEL **[J] ATRSZ= 7 ; WORDS TO HOLD ALL POSSIBLE ATTRIBUTES LINSZ= 66 ; WORDS TO HOLD LONGEST FORMAT LINE SFNAME= 1 ; POINTER TO SORT FILE NAME KSW= SFNAME+1; NO LINK SWITCH BP= KSW+1 ; -> BUF FOR DIRECTORY CP= BP+1 ; CMD LINE PTR SBP= CP+1 ; -> BUFFER FOR ALPHA LIS2 PATH= SBP+1 ; PATH SWITCH ALL= PATH+1 ; PERMANENT TOO ALPH= ALL+1 ; ALPHABETIC LIST SWITCH EVR= ALPH+1 ; ADDITIONAL LIST OPTIONS TPOS= EVR+1 ; TAB COLUMN POSITION TAB= TPOS+1 ; RUNNING TABLE ADDRESS PXP= TAB+1 ; -> PEXT PEXT= PXP+1 ; SPACE TO BUILD FILENAME ARGP= PEXT+30 ; -> ARG STORAGE ATRPX= ARGP+1 ; RUNNING PTR T ATTRS TMP= ATRPX+1 TMP1= TMP+1 ATRS= TMP1+1 ; PLACE TO STORE ATTRIBUTES SBI1= ATRS ; SORT BUFFER INFO)RMATION SPACE COUNT= ATRS+ATRSZ+1 ; FILE BYTE COUNT - LOW ORDER SBI2= COUNT ; SORT BUFFER 2 INFORMATION SPACE HCNT= COUNT+1 ; HIGH ORDER DA= HCNT+1 MO= DA+1 YR= MO+1 HR= YR+1 MN= HR+1 ACDA= MN+1 ; ACCESS TIMES ACMO= ACDA+1 ACYR= ACMO+1 HFIRAD= `ACYR+1 FIRAD= HFIRAD+1 USRC= FIRAD+1 ; USER COUNT TLOGB= ACMO ; BLOCK# OF LAST SWITCH IN BUBBLE ENCK= ACYR ; RUNNING COUNT OF ENTRIES LEFT IN SORT IVAL= FIRAD ; CURRENT INTERVAL FOR SORT BCNT= USRC ; POSITIONS BUBBLED IN LAST SORT PASS LCHAN= USRC{+1 CNAM= LCHAN+1 CNAMP= CNAM+10 ; ->CNAM DIRSP= CNAMP+1 ; DIRECTORY SPECIFIER PTR ALIP= DIRSP+1 ; ALIAS NAME PTR NAMP= ALIP+1 ; NAME PTR EP= NAMP+1 ; ENTRY SPACE PTR FP= EP+1 ; FORMAT LINE PTR FBUF= FP+1 ; FORMAT LINE BUFFER ENTSZ= FBUF+LINSZ ; E\NTRY SIZE FOR DIRECTORY READ CDCH= ENTSZ+1 ; CURRENT DIR CHANNEL# CDB= CDCH+1 ; CURRENT DIRECTORY BLOCK# BUF= CDB+1 ; DIRECTORY BUFFER ECNT= BUF+1 SHED= BUF+SCDBS+1 ; BEGINNING OF BUFFER HEADER SBUF= SHED+3 ; SECOND BUFFER FOR ALPHA LIST PEND= SBUF+/SCDBS+1 PEND LIS2: ISZ SSRTN,2 STA 0,CP,3 ; SAVE CMD PTR BPT ATRS ARGP,CNAM CNAMP,BUF BP,PEXT PXP LDA 1,TABAD ; FORMAT TABLE ADDRESS STA 1,TAB,3 ; RUNNING ADDRESS C GETSW ; GET GLOBAL SWITCHES SW K ; TEST NO LINK SWITCH LDA 0,ASW AND 1,0 STA" 0,ALL,3 ; /A ALL LDA 0,SSW ; /S ORT ALPHABETICALLY AND 2,0,SNR JMP NOALF STA 2,TMP,3 ; KEEP 2ND BANK OF SWITCHES LDA 0,TMPFN ; TEMPORARY FILE NAME LDA 2,USTP ; FIND OUT WHAT GROUND LDA 2,USTPC,2 ; FG/BG FLAG MOV 2,2,SNR ; FG? INC 0,0 ; NO DROPE F STA 0,SFNAM,3 ; SAVE NAME POINTER S DELETE LDA 2,TMP,3 ; WIPED OUT THE SWITCH WORD S CRAND ; CREATE A TEMPORARY FILE FOR NAMES JMP @LSD S OPEN TCH NOP ADC 0,0 ; SET FILE COUNT INITIALLY = -1 NOALF: STA 0,ALPH,3 LDA 0,ESWU ; /E EVERYTHING AND2# 1,0,SNR JMP .+3 ; NOT SET ADC 2,2 ; SET - TURN ON EVERYTHING JMP SETFL ANDZ 0,2,SZR ; /U SER COUNT SUBZL 2,2 ; SET FIRST BIT LDA 0,FSW ; /F FIRST ADDRESS ANDZ 1,0,SZR MOVO 0,0 ; SET CARRY IF SWITCH ON MOVL 2,2 LDA 0,OSW ; /O LAST OPENED AND 1,0,SZR MOVO 0,0 MOVL 2,2 LDA 0,CSW ; /C CREATE DATE AND 1,0,SZR MOVO 0,0 MOVL 2,2,SZR ADDOR 2,2 ; SET 1B0 IF ANY OPTION SET LDA 0,BSW ; /B RIEF LIST - NAME ONLY AND# 1,0,SNR ADD 0,2,SKP ; SET 1B1 IF NO /B MOV# 2,2,SZR SETFL: ISZ TAB,3 ; BUMP PAST FIRST ENTRY IF ANYTHING SET STA 2,EVR,3 ** .DO CCOND LDA 0,LSW ; /L AND# 1,0,SNR JMP LDEV SUB 1,1 ; LIST TO PRINTER LDA 0,LPTN S OPEN LCH JMP @LSD LDA 1,LCHD ; LPT OUTPUT CHANNEL JMP .+2 ** .ENDC LDEV: SUBZL 1,1 ; DEFAULT OUTPUT CHANNEL ST=-A 1,LCHAN,3 ** .DO CCOND==1 LDA 0,PXP,3 ; GET DIRECTORY NAME MOVZR 0,1 S GDIR NOP MOV 1,3 ; MAKE IT ACCESSABLE CLER UFTEX ; GET RID OF .DR LDA 3,USP ; RESTORE USP LDA 0,LISMS LDA 1,LCHAN,3 MOVZR# 1,1,SNR ; LINE PRINTER LISTING ?? JMP NOHDR ; 2^NO SKIP HEADER C WRLCH PXP C TIMR ** .ENDC JMP NOHDR TABAD: FTAB-1 LSD: LSER ASW: A.SW SSW: CSW: C.SW ESWU: E.SW FSW: F.SW OSW: O.SW LPTN: NLPT*2 TMPFN: TMPN*2 LISMS: LISTM*2 NOHDR: ADDL# 2,2,SZC ; /B SET? JMP LONG LDA 0,BLIN ; FORMAT FOR BRIEF LI"NE MOVL# 2,2,SZC ; OTHER SWITCHES? LDA 0,EXBL ; YES - USE EXTENDED BRIEF LINE LDA 1,CAR ; TAB TO COL 15 AFTER JMP FORLN LONG: LDA 0,LINE ; FORMAT FOR REGULAR LINE LDA 1,T41 ; TAB TO COL 41 AFTER FORLN: STA 1,TPOS,3 ; FIRST TAB POSITION FOR NEXT HUNK LDA 1,FPD ; MAKE PTR TO FORMAT LINE BUFFER ADDZL 3,1 STA 1,FP,3 MVIN: C MOVE ; MOVE SELECTED LINE IN ISZ TAB,3 LDA 0,@TAB,3 ; -1 IS END OF TABLE COM# 0,0,SNR JMP FIN ; SKIP LONG FORMAT LINE MOVR 2,2,SNC ; CHECK NEXT BIT OF SWITCH WORD JMP IG ; NOT SET - IGNORE ARG  LDA 0,UPTP ; PTR TO ^T C MOVE ; SET TAB TO NEXT SPACE MOV 1,0 LDA 1,TPOS,3 ; NEXT TAB POS C STBT ; SET NUMBER POS INTO LINE LDA 3,@TAB,3 ; COLUMNS FOR THIS ONE ADD 3,1 ; NEW NEXT COLUMN LDA 3,USP STA 1,TPOS,3 ; UPDATE NEXT :COL INC 0,1 ; LINE PTR ISZ TAB,3 ; BUMP PAST TAB VALUE LDA 0,@TAB,3 ; SWITCH SET FORMAT LINE ISZ TAB,3 JMP MVIN IG: ISZ TAB,3 ; MOVE TABLE UP ISZ TAB,3 ; PAST SW SET LINE LDA 0,@TAB,3 ; SW NOT SET LINE JMP MVIN FIN: MOV 1,0 LDA 1,CAR ; CARRIAGE RETURN C STBT ; FINISH OFF LINE INC 0,0 ; BUMP LINE PTR SUB 1,1 ; NULL TERMINATOR C STBT ; PUT IT OUT STA 1,PATH,3 ; SET PATH FLAG LDA 2,.SBUFR ; SET UP CP TO POINT TO FIRST ARG LDA 0,BFRPT,2 STA 0,CP,3 JMP ENLP ; GO TO IT BSW: B.SW LSW: L.SW .SBUFR: SBUFR ; ARG PATH SWITCH (SW): ; 1B1 ALPHA LIST 2ND PASS FTAB: -1 ; EARLY CUTOUT SWITCH 16. ; COLUMNS FOR THIS ARG CR*2 ; SWITCH SET LINE IG5*2 ; SWITCH NOT SET LINE 10. ACS*2 IG3*2 10. FAD*2 IG2*2 0 USCL*2 IG1*2 -1 ** .NOLOcC 1 UPTP: .+1*2 .TXT /^T/ ** .NOLOC 0 CAR: 15 T41: 41 FPD: FBUF ** .DO CCOND LCHD: LCH ** .ENDC BLIN: BRF*2 EXBL: EXBLN*2 LINE: REGLN*2 BUFD: BUF SBUFD: SBUF ENLP: LDA 2,PATH,3 ; WHICH PATH? ADDZL# 2,2,SZC ; 1B1 SET - ALPHA PASS JMP CONT ; YES KEEP CHUNKING THROUGH TMP.TM LDA 2,.SBUFR ; AC2 = BUFFER ADDRESS LDA 0,CP,3 ; AC0 = BUFFER POINTER LDA 1,PXP,3 ; AC1 = PLACE TO PUT NAME C GARBU ; GET NEXT ARGUMENT JMP @LRAD ; ALL DONE STA 0,CP,3 MOV 1,0 JMP GSTAT ; OUTPUT IT CONT: LDA 0,BP,3 C RDSYNS ; GET NEXT ENTRY FOR TMP.TM JMP LRDER ; END OF FILE ALL DONE LDA 0,PXP,3 C SNTUN ; CONVERT TO USER NAME GSTAT: LDA 1,BUFD ADD 3,1 ; FILE ENTRY SPACE ADDRESS S STAT ; GET FILE INFORMATION JMP ERST MOV 1,2 STA 0,NAMP,3 ; SAVE NAME LDA 0,UFTATL,2 LDA 1,ALL,3 COML 1,1 ; CLEAR CARRY IF /A SET LDA 1,PATT AND# 0,1,SEZ ; PERM FILE WITHOUT /A ?? JMP ENLP ; YES - SKIP IT LDA 1,ALPH,3 ; CHECK ALPHA LIST SWITCH MOV# 1,1,SZR JMP ALOUT ; OUTPUT TO THE ALPHA TEMP FILE LDA 1,EVR,3 ; SWITCH FLAG WO4(RD MOV# 1,1,SZR ; ANY FLAGS SET? JMP SIZ ; YES - KEEP GOING LDA 0,FP,3 ; FORMAT LINE LDA 1,LCHAN,3 C WRLCH NAMP JMP ENLP ; GO FOR NEXT ALOUT: LDA 0,NAMP,3 ; CHECK FOR DUMMY FILE LDA 1,SFNAM,3 ; TMP.TM C COMP JMP ENLP ; YUP SKIP HIM ISZ ALPH,@3 ; ALPHA FILE OUTPUT - COUNT THEM JMP ALCONT SUB 1,1 ; FIRST TIME THROUGH - INITIALIZE FILE LDA 0,SBUFD ADD 3,0 ; MAKE PTR TO SECOND BUFFER STA 0,SBP,3 C ALSF ; INIT SORT FILE/BUFFER FOR ALPHA NAMES ISZ ALPH,3 ; COUNT FIRST FILE ALCONT: MOV 2,0  ; ADDRESS OF FILE ENTRY LDA 1,SBP,3 ; PTR TO BUFFER C WRALF ; WRITE ENTRY TO ALPHA LIST TEMP FILE JMP @ALERP ; MUST BE FLUSH ERROR TO TMP.TM JMP ENLP ALERP: ALER LRAD: LRET ATCR: ATRAN+ATCON C377: 377 EOF: EREOF NOF: ERDLE LSAD: LSER ERST: LDA 1,NOrF ; ERROR ON .STAT CALL SUB# 1,2,SNR JMP ENLP ; FILE DOESNT EXIST - IGNORE IT JMP @LSAD ; OTHER PROBLEM MUST BE BAD NEWS LRDER: LDA 0,EOF SUB# 0,2,SNR ; END OF FILE IN TMP.TL? JMP @LRAD ; YES - THATS IT FOLKS JMP @ALERP ; NO - GIVE ERROR ; COMPUTE BYTES IN FILE SIZ: STA 2,EP,3 ; KEEP ENTRY PTR ADDL# 1,1,SNC ; /B SET? JMP CREA ; YES - SKIP ATTRS AND SIZE LDA 1,UFTAT,2 ; FILE ATTRIBUTES LDA 0,LNAT AND# 1,0,SZR ; LINK FILE? JMP ATRIB LDA 0,UFTBC,2 ; BYTE COUNT LAST BLOCK LDA 1,UFTBK,2 ; NUMBER OF BLOCKS LDA 2,UFTP2,2 ; NUMBER OF WORDS/BLOCK MOVZL 2,2 ; NUMBER OF BYTES PER BLOCK LDA 3,CM20 ; COMPUTE NUMBER OF WORDS PER FILE SIZN: MOVR 1,1,SNC ; CHECK FOR NEXT MULTIPLIER BIT MOVR 0,0,SKP ; 0 JUST SHIFT ADDZR 2,0 ; 1 ADD AND SHIFT INC ]3,3,SZR ; DONE ?? JMP SIZN ; NO TRY AGAIN MOVCR 1,1 ; GET THE LAST ONE LDA 3,USP ; RESTORE STACK POINTER STA 0,HCNT,3 ; STORE SIZE WORDS STA 1,COUNT,3 JMP ATRIB CM20: -20 ; ATTRIBUTE MNEMONICS ATRIB: LDA 0,ARGP,3 ; PTR TO ATTRS SPACE STA 0,ATRPX,3 LDA 2,EP,3 LDA 2,UFTAT,2 LATR: LDA 0,CARP ; MNEMONICS PTR STA 0,TMP1,3 ; RUNNING PTR IN STACK LDA 0,ATTRD STA 0,TMP,3 ; CODES PTR LOOP2: LDA 0,@TMP,3 ; GET A CODE ISZ TMP,3 ISZ TMP1,3 COM# 0,0,SNR ; END OF TABLE IS -1 JMP DONE AND# 0,2,SNR mJMP LOOP2 LDA 0,TMP1,3 ; MATCH C LDBT ; LOAD MNEMONIC LDA 0,ATRPX,3 C STBT ISZ ATRPX,3 JMP LOOP2 ; TRY FOR ANOTHER ONE DONE: SUBC 1,1 ; STUFF OUT FINAL NULL LDA 0,ATRPX,3 C STBT LDA 1,LNAT ; LINK ATTRIB AND# 1,2,SZR ; LINKS PART COMPANY HERE JGMP LINK ; RESOLVE AND OUTPUT LINK FORMAT LDA 2,EP,3 ; ENTRY PTR LDA 2,UFTLK,2 ; LINK ACCESS ATTRIBUTES MOVC 2,2,SBN ; FLIP CARRY AND CHECK WORD JMP CREA ; CARRY 0(2ND TIME AROUND) OR NO ATTRS LDA 1,SLSH ; SEPARATE GROUPS WITH SLASH C STBT ; PUT IT IN LINE ISZ ATRPX,3 ; BUMP LINE PTR JMP LATR ; NOW REPEAT FOR LINK ACCESS ATTRD: .+1 ATRP ATTP: ATCHA ATSAV PATT: ATPER ATWP ATRAN ATCON LNAT: ATLNK ATPAR ATDIR ATNRS ATUS1 ATUS2 -1 ** .NOLOC 1 CARP: .+1*2-1 .TXT /RASPWDCLTYN&?/ ** .NOLOC 0.6 SLSH: "/ ; FILE CREATION DATE/TIME CREA: LDA 2,EP,3 ; ENTRY PTR LDA 0,LNAT LDA 1,UFTAT,2 AND# 1,0,SZR ; DID A LINK SLIP THRU ?? JMP LINK ; YES GET RID OF IT LDA 1,EVR,3 ; ANY SET? MOVL# 1,1,SNC ; CHECK 1B0 FOR OPTIONS JMP OUT ; NONE SET - DONTԩ CALCULATE THEM MOVR 1,1,SNC ; /C SET? JMP ACC STA 1,TMP,3 ; YEP LDA 0,UFTYD,2 ; YEAR/DAY LDA 1,FTIM ADD 3,1 ; ADDR OF TIME SPACE C DAYCV ; CHANGE JULIAN TO D/M/Y LDA 0,UFTHM,2 ; HOUR/MIN LDA 1,C377 AND 0,1 ; EXTRACT RIGHT HALF (MINUTE) SUBS G1,0 ; SEPARATE AND MOVE HOUR STA 1,MN,3 ; KEEP MIN STA 0,HR,3 ; HOUR LDA 1,TMP,3 ; FILE LAST OPENED - DATE ACC: MOVR 1,1,SNC ; /O SET? JMP SADR ; NO STA 1,TMP,3 ; KEEP SHIFTED VALUE LDA 0,UFTAC,2 ; YES - FIND LAST ACCESS LDA 1,FATIM ADD 3,1 ; ADDR OF ACCESS TIME SP@CE C DAYCV LDA 1,TMP,3 SADR: MOVR 1,1,SNC ; /F FIRST ADDRESS JMP USER ; NO - GO TO FINISH LINE LDA 0,UFTAD,2 ; FIRST ADDRESS STA 0,FIRAD,3 ; KEEP IN A SAFE PLACE LDA 0,UFTDL,2 ; GET HIGH ORDER PART LDA 3,.ATMSK ; MASK OUT TRA#SH ANDS 3,0 LDA 3,USP ; RESTORE USP STA 0,HFIRA,3 ; STORE HIGH HALF USER: MOVR 1,1,SNC ; /U SET? JMP OUT LDA 0,UFTUC,2 LDA 1,UMSK ; MASK OFF COUNT FROM LOCK BITS AND 1,0 STA 0,USRC,3 ; PUT USER COUNT IN STACK OUT: LDA 1,LCHAN,3 ; OUTPUT CHANNEL NO. LDA 0,FP,3 ; FORMAT LINE C WRLCH NAMP HCNT COUNT ARGP MO FTIM: DA YR HR MN ACMO FATIM: ACDA ACYR HFIRAD FIRAD USRC JMP @ENLD .ATMSK: ATMSK LINK: SKZ KSW ; WANT LINKS ?? JMP @ENLD ; NO FORGET THEM LDA 2,EP,3 ; RETRIEVE ENTRY PTR  LDA 1,UFLAD,2 ; FIRST WORD OF DIR SPECIF ENTRY MOV# 1,1,SNR ; ANYTHING THERE? JMP USAT ; NO LDA 0,ADRAD ; YES - MAKE PTR TO IT ADDZL 2,0,SKP ; PTR TO NAME.EXT USAT: LDA 0,ATP ; NO - USE @ FOR PRIM DIR STA 0,DIRSP,3 ; KEEP PTR TO WHICHEVER LDA 1,UFLAN,2 ; FIRST WORD OF ALIAS NAME MOV# 1,1,SNR ; NAME THERE? JMP LKNAM ; NO - USE PRIMARY NAME LDA 0,ALIAD ; ALIAS NAME OFFSET IN ENTRY ADD 0,2 ; MAKE PTR TO IT LDA 0,CNAMP,3 ; BUFFER SPACE PTR C SNTUN ; MAKE USER-TYPE NAME OF IT SUB 1,1 STA 1,0,2 ;qC WIPE OUT FIRST WORD JMP .+2 LKNAM: LDA 0,NAMP,3 ; PTR TO PRIMARY NAME STA 0,ALIP,3 ; RELOSUTION NAME PTR LDA 0,LKLIN LDA 1,EVR,3 ADDZL# 1,1,SNC ; /B ?? LDA 0,BLKLI ; YES USE BRIEF LINE LDA 1,LCHAN,3 C WRLCH NAMP ; LINK'S NAME DIRSP ; DIRECTOhRY SPECIFIER ALIP ; RESOLUTION FILE'S NAME JMP @ENLD LKLIN: LNKO*2 UMSK: 7777 ATP: ATTP*2 ALIAD: UFLAN ADRAD: UFLAD ENLD: ENLP BLKLI: BLNKO*2 ALER: LDA 0,SFNAM,3 ; SCRATCH FILE NAME LSER: ER1 2 ; REPORT ERROR JMP LR1 ; DOESN'T WANT IT FATAL LDA te2,SSOSP,3 ; WANTS IT FATAL DSZ SSRTN,2 LRET: LDA 0,ALPH,3 COM# 0,0,SNR ; CHECK FOR ALPHA BUT NO FILES JMP .+3 ; SKIP SORT THEN MOV# 0,0,SZR ; WAS THIS AN ALPHA PASS? JMP SORT ; YES LR1: S CLOS TCH ; CLOSE ALPHA TEMPORARY FILE JMP LR2 ; MUST NOT HAV.E BEEN USED LDA 0,SFNAM,3 ; FILENAME S DELET ; DELETE ALPHA TEMPORARY FILE NOP LR2: ** .DO CCOND LDA 1,LCHDX LDA 2,LCHAN,3 SUB# 1,2,SZR RTRN S CLOS LCH NOP ** .ENDC RTRN LCHDX: LCH SBI1D: SBI1+1 SBI2D: SBI2+1 PXD: PEXT BUFDX: BUF SORT: SUB 1,1 LDA 0,SBP,3 ; BUFFER PTR C WRFB ; GO WRITE OUT FINAL BLOCK JMP ALER ; MUST BE FLUSH ERROR TO TMP.TM LDA 0,PXD ; MAKE ADDRESS PTR FOR NAME SPACE ADD 3,0 STA 0,PXP,3 LDA 2,SBI1D ; MAKE ADDRESS OF ITEM-A INFORMATION SECTION ADD 3,2 STA 2,SBI1,3 6; THREE-WORD SUB BUFFER STA 2,LOGB,2 ; INITIALIZE BLOCK# ANY NONZERO NO. LDA 0,SBI2D ADD 3,0 ; ITEM-B INFORMATION SECTION STA 0,SBI2,3 STA 2,@SBI2,3 ; FIRST ITEM IS ADDRESS OF OTHER ITEM INFO STA 0,@SBI1,3 MOV 0,2 STA 2,LOGB,2 ; NONZERO INITIAL BL0OCK# LDA 2,BUFDX ; RECYCLE SYS.DR BUFFER AS ITEM-A FIRST BUFFER ADD 3,2 ; KEEP ADDRESS IN STACK STA 2,BP,3 STA 2,SBI1+1+BUFP,3 ; PUT IT IN SUB BUFFER INFO SECTION STA 1,STATS,2 ; INITIAL STATUS STA 1,SHARE,2 ; NOT SHARED LDA 2,SBP,3 ; RECYCLE TEMP I|FILENAMES BUFFER FOR ITEM-B STA 2,SBI2+1+BUFP,3 STA 1,STATS,2 ; INITIAL STATUS CLEAR STA 1,SHARE,2 ; ALSO SHARE STATUS LDA 0,ALPH,3 ; INITIAL INTERVAL ADC 1,1 ; (2^K)-1 WHERE 2^KSNC ; UNTIL LEADING BIT OF FILECOUNT DETECTED JMP .-2 ; BEGINNING OF PASS THROUGH FILENAME FILE IN SHELL-TYPE SORT TOP: STA 1,IVAL,3 ; KEEP CURRENT SORT INTERVAL LDA 2,ALPH,3 ; TOTAL ENTRIES TO SORT SUB 1,2 ; LESS INTERVAL = ENTRIES TO GO STA 2,ENCsK,3 ; KEEP TRACK HOW FAR DOWN DURRING PASS MOVZR 1,2,SNR ; KEEP INTERVAL SAFE STA 1,ENCK,3 ; IF INTERVAL = 1,INIT ENCK AS 1 LDA 0,SBI2,3 ; ITEM B INFO ADDRESS C REPOS ; POSITION FILES TO BEGINNING AGAIN- ; ITEM B=LOC. A+INTERVAL (=INTERVAL) JMP ALER ; END OF FILE CONDITION SUB 1,1 ; ITEM A = 0 LDA 0,SBI1,3 ; ITEM A INFO ADDRESS STA 0,TMP,3 C REPOS ; REPOSITION BOTH JMP ALER ; ERROR LDA 0,SBI1+1+ENTAD,3 ; ENTRY ADDRESS, FIRST A LDA 1,SBI2+1+ENTAD,3 ; ENTRY ADDRESS, FIRST B MOV# 2,2,SNR JMgP BUB1 ; IF INTERVAL=1, DO BUBBLE SORT INSTEAD MOV 0,2 JMP COMPR ; CYCLE WITHIN PASS FOR COMPARING PAIRS OF FILENAMES GPAIR: LDA 0,SBI2,3 ; ITEM B INFO ADDRESS C STEP ; GET NEXT ITEM ADDRESS JMP EOFS MOV 2,1 ; HOLD ONTO ENTRY ADDRESS LDA 0,SBI1,3 ; ITEM A INFO ADDRESS C STEP ; NOW GET A JMP ALER MOV 2,0 COMPR: C RANK ; COMPARE TWO NAMES FOR ALPHABETIC PRECEDENCE JMP NXPAR ; A<=B, DONT SWITCH LDA 0,ALENT ; COUNT 6 WORDS STA 0,TMP1,3 STA 1,TMP,3 ; KEEP ADDR OF 2ND IN STACK SWAP: LDA 0,0,2 ; GET WORD FROM A LDA 1,@TMP,3 ; GET WORD FROM B STA 0,@TMP,3 ; PUT THEM BACK, REVERSED STA 1,0,2 INC 2,2 ; MOVE ADDRESSES UP ISZ TMP,3 DSZ TMP1,3 ; COUNT WORDS JMP SWAP LDA 2,SBI1+1+BUFP,3 ; FILE A BUFFER ADDRESS ISZ STATS,2 ; SET STATUS MODIFIED LDA 2,SBI2+1+BUFP,3 ; FILE B BUFFER ADDRESS ISZ STATS,2 ; SWITCH ENTRIES MODIFIES BOTH NXPAR: DSZ ENCK,3 ; LOOK FOR LAST ENTRY JMP GPAIR ; STILL SOME LEFT - GET NEXT PAIR EOFS: LDA 1,IVAL,3 ; CALCULATE NEW INTERVAL FOR NEXT PASS NEG 1,1 ; NEW IVAL = (IVAL-1)/2 COMZR 1,1,SNR SUBZL 1,1 ; HAS TO BE AT LEAST ONE JMP TOP ALENT: SCFNL ; COMPARE ONE AGAINST NEXT, MOVE BACK AS FAR AS IT WILL GO BUB: LDA 0,TMP,3 ; GET ADDR OF OLD A LDA 2,@TMP,3 ; TMP HOLDS CURRENT A INFO ADDRESS NEWB: STA 2,TMP,3&C ; SWITCH FOR NEXT TIME C STEP ; LEAPFROG OVER OLD B (NEW A) FOR NEW B JMP SORTD ; END OF THE LINE C STEP ; GET NEXT ENTRY FOR 2ND SLOT JMP SORTD ISZ ENCK,3 ; KEEP COUNT OF ITEM B POSITION MOV 1,0 ; PREVIOUS B BECOMES A MOV 2,1 BUB1: C RANK JMP }BUB ; RIP THROUGH ALTERNATING ENTRIES STA 0,TMP1,3 ; KEEP ORIGINAL A MOV 1,0 ; MOVE B TO TEMP SPACE LDA 1,PXP,3 ; PTR TO TEMP SPACE C EMOV ; MOVE 2ND ENTRY TO TEMP SPACE- ; HOLD UNTIL BUBBLED POSITION DETERMINED MOV 0,1 ; ORIGINAL B LDA 2,TMP,3 ; INFOR ADDRESS LDA 0,@BUFP,2 ; TOTAL ENTRIES IN BLOCK LDA 2,ELFT,2 ; ENTRIES AVAILABLE ADC 2,0 ; COMPLEMENT FOR BUBBLING BACK LDA 2,TMP,3 ; ADDR AGAIN STA 0,ELFT,2 ; NEW AVAIL ENTRIES GOING BACKWARDS SUBO 0,0 ; NEW BUBBLE SEEKING PLACE, CLEAR CkARRY STA 0,BCNT,3 ; NUMBER OF POSITIONS MOVED BACK LDA 0,TMP1,3 ; MOVE A DOWN ONE ENTRY-SPACE LDA 2,OBUF,2 ; GET ITEM B BUFFER ADDRESS LDA 2,BUFP,2 ; FIRST TIME STATUS CHANGE ON B JMP BUB2 NXTUP: MOV 2,1 ; OLD A BECOMES NEW DESTINATION LSTUP: LDA 2y,TMP1,3 ; MAKE SURE STATUS CHANGES IN ORIG BUF LDA 2,BUFP,2 ; EVEN IF BACKUP MOVED TO NEW ONE BUB2: ISZ STATS,2 ; SET MODIFIED C EMOV ; MOVE A INTO VACATED ENTRY SPACE MOV 0,1,SZC ; ADDR OF NEW FREE ENTRY SPACE JMP SDONE LDA 0,TMP,3 STA 0,TMP1,3 ; HYANG ONTO ORIGINAL INFO ADDR C BSTEP ; GET NEW ENTRY BACK ONE FROM A JMP BTOP ; ERROR OR EOF - STOP BUBBLING DSZ BCNT,3 ; KEEP TRACK OF HOW FAR IT WENT MOV 2,0 ; FILE ADDR NEW A MOVZ 1,2 ; HOLD ONTO OLD A LDA 1,PXP,3 ; COMPARE BACK, MOVING EACH DOWN55 EN ROUTE C RANK MOVO 1,0 ; NO SWITCH THIS TIME - END OF BUBBLE JMP NXTUP BTOP: LDA 0,PXP,3 ; MOVE BUBBLE FROM BENCH BACK INTO PLAY MOVO 0,0 ; SET CARRY FOR LAST SWAP JMP LSTUP SDONE: LDA 2,TMP,3 ; CURRENT A INFO ADDRESS LDA 1,ELFT,2 ; AVAIL ENTRIEfqS UNSEARCHED LDA 0,@BUFP,2 ; TOTAL ENTRIES IN BLOCK ADC 1,0 ; RECOMPLEMENT FOR FORWARD AGAIN STA 0,ELFT,2 ; RESTORE IN INFO BLOCK MOV 2,0 LDA 1,BCNT,3 ; HOW FAR DID IT GO MOV# 1,1,SNR JMP SAM C REPOS ; REPOSITION IT JMP SORTD SAM: LDA 2,@TMP,3 ;7 PREVIOUS B BECOMES A LDA 1,ENTAD,2 COM# 1,1,SZR ; CHECK FOR BUBBLED OVER FLAG JMP NEWB ; GO TAKE THE NEXT PAIR LDA 1,ENCK,3 ; PREVIOUS POSITION OF B FILE MOV 2,0 ; INFO ADDR C REPOS ; RESTORE ITEM TO PREVIOUS POSISION JMP SORTD ; REACHED END? LDA 1,ENTAD,2 ; OLD B ENTRY ADDRESS JMP BUB SORTD: LDA 1,EOFCX SUBO 2,1,SZR JMP @ALRD STA 1,ALPH,3 ; RESET ALPHA FLAG FOR NEXT PASS LDA 1,ALSW ; ALPHA 2ND PASS PATH SWITCH STA 1,PATH,3 LDA 2,TMP,3 ; WRITE OUT FINAL BLOCKS FLP: LDA 1,LOGB,2 ; BLOCK#g LDA 2,BUFP,2 ; BUFFER ADDRESS LDA 0,SHARE,2 ; SEE IF IT IS SHARED MOV# 0,0,SZR MOVO 0,0 ; IT IS - SET CARRY TO SKIP NEXT ROUND LDA 0,STATS,2 ; NOW CHECK MODIFIED FLAG MOV# 0,0,SNR ; NO POINT WRITING SAME THING JMP FNX ; NOT MODIFIED - GO CHECK OTHgKER MOV 2,0 ; BUFFER ADDRESS INTO POSITION C FLUSH ; MOVE IT OUT JMP @ALRD FNX: LDA 2,@TMP,3 ; OTHER GUY'S INFO MOVC 2,2,SZC ; COMPLEMENT FLAG AND CHECK FOR BOTH DONE JMP FLP ; ONE TO GO LDA 0,PXP,3 ; MAKE BYTE PTR AGAIN MOVZL 0,0 STA 0,PXP,3 LDA 2,SBP,3 ; SORT BUFFER ADDR NEG 2,0 ; BACK IT UP ONE COMZL 0,0 ; AND MAKE BYTE PTR STA 0,BP,3 ; BUFFER PTR MOVZR 0,0 ; ADDRESS C ALSF ; REINITIALIZE ALPHA FILE LDA 1,ALENT ; ENTRY SIZE STA 1,-4,2 ; PUT IN PHONY SYS.DR HEADR JMP @.+1 CONT ; GO@ PRINT AS FOR SYS.DR ALSW: 1B1 ALRD: ALER EOFCX: EREOF ; TEXT AND LONGIES ** .NOLOC 1 ; DON'T WANT TO SEE ALL THIS STUFF TMPN: .TXT /FTML.TM/ NLPT: .TXT /$LPT/ BRF: .TXT /^C/ EXBLN: .TXT /^C^I^I^I/ REGLN: .TXT /^C^T<15>^P^B<10.> ^C/ CR: .TXT *^D^Z<2>/';^D^Z<2>/^D^Z<2> ^D^Z<2>:^D^Z<2>* ACS: .TXT *^D^Z<2>/^D^Z<2>/^D^Z<2>* FAD: .TXT /[^Q^Z<6>]/ USCL: .TXT /^D^B<4>/ LNKO: .TXT /^C^T<32>^C:^C<15>/ LISTM: .TXT / ^C^T<70>/ BLNKO: .TXT /^C^I^I<15>/ ** .NOLOC 0 IG5: '^I' IG4: '^I' IG3: '^I' IG2: '^I' IG1: '^I' ~0 ; STRING TERMINATOR ; ; CONVERT JULIAN DAY TO DAY/MONTH/YEAR ; ; INPUT: AC0 - JULIAN DAY SINCE 1/1/68 ; AC1 - ADDRESS OF 3 WORD SPACE FOR DAY/MO/YEAR DASP=1 ; DATE SPACE ADDRESS DASP DAYCV: STA 1,DASP,3 SUB 2,2,SKP ; BEGIN WITH YEAR 0 YRLP: INC 2,2 ; NEXT YEAR LDA 1,CM366 ; -(DAYS IN LEAP YEAR) MOVZR 2,3,SNC ; 1 IN B15? MOVR 3,3,SZC ; OR B14 INC 1,1 ; ONE OR BOTH SET - NOT LEAP YEAR ADDZ 1,0,SEZ ; SUBTRACT A YEAR OF DAYS JMP YRLP ; NOT THERE YET SUB 1,0 ; ONE OVER - RESTORE IT LDA 1,C68 ; BASE YEAR ADD 1,2 ; THIS YEAR LDA 3,USP LDA 3,DASP,3 STA 2,2,3 ; STORE YEAR SUBZL 1,1 STA 1,1,3 ; START WITH MONTH 1 LDA 1,C31 ; 31 DAYS HATH JANUARY SUBZ 1,0,SBN ; SKP IF DAYS > JAN. JMP GOTMO LDA 1,C28 ; FEBRUARY... COMZR 2,2,SZC ; CHECK" BIT 15 - LEAP YEAR? MOVR 2,2 ; NOW BIT 14 - CARRY=0 NO, 1 YES LDA 2,MWRD ; WORD WITH BITS SET FOR 31 DAY MONTHS MOVR 2,2,SKP ; MOVE CARRY INTO FEB'S PLACE MOLP: LDA 1,C30 ; 30 DAYS HATH EVERYBODY ISZ 1,3 ; NEW MONTH MOVL 2,2,SZC ; UNLESS BIT SET IN!C 1,1 SUBZ 1,0,SEZ ; TAKE OFF THIS MONTHS DAYS JMP MOLP GOTMO: ADD 1,0 ; WENT PAST IT STA 0,0,3 ; STORE DAY RTRN CM366: -366. C28: 28. C30: 30. C31: 31. C68: 68. MWRD: 126500 ; 1010110101000000 ; ; SYSTEM NAME TO USER NAME ; AC0 -> USER NAME ; AC2F -> SYSTEM NAME ADDRESS ; C SNTUN EXTX=1 ; EXTENSION STORAGE .STSZ=1 ; FRAME SIZE .STSZ SNTUN: LDA 2,SSAC2,2 ; LOAD ADDRESS LDA 1,SCEXT,2 ; LOAD EXTENSION STA 1,EXTX,3 ; SAVE INSTACK SUB 1,1 ; CLEAR AC STA 1,SCEXT,2 ; CLEAR IN NAME SPACE MOVZLݶ 2,2 ; MAKE A BYTE POINTER MOV 0,1 LDA 0,LINEX C WRBIN SSAC2 EXTX MOVZR 2,2 ; ADDRESS AGAIN LDA 0,EXTX,3 STA 0,SCEXT,2 ; REPLACE EXT RTRN  ** .NOLOC 1 LINEX: .+1*2 .TXT /^C.^W/ ** .NOLOC 0 CM6: -6 SYSENT: UFDEL ; ; READ NEXT ENTRY FROM SYS.DR ; AC0 -> BUFFER ; AC1 = CHANNEL # ; AC2 = RETURNED ENTRY ADDRESS ; C RDSYS ; -ERROR OR EOF (CODE IN AC2) ; -NORMAL RETURN 0 RDSYS: ISZ SSRTN,2 ; ASSUME NORMAL RETURN MOVZR 0,2 ; BUILD BUFFER ADDRESS .LOOP: LDA 0,1,2 ; ENTRY COUNT MOV# 0,0,SZR JMP ENTF INC 2,0 LDA 1,-1,2 ; LOG. BLK NO. ISZ -1,2 ; NEXT BLOCK NTXT TIME LDA 2,-2,2 ; CHANNEL S RDB CPU JMP SERR NEG 0,2 ; BACKUP BUFFER ADDRESS COM 2,2 INC 0,0 ; MOVE ENTRY ADDRESS FORWARD STA 0,0,2 JMP .LOOP ENTF: LDA @0,0,2 ; NAME WORD NEGO 0,0 ; SET CARRY IF NON VACENT LDA 0,-3,2 ; THIS IS ENTSZ OFFSET IN CALLING ROUTINE LDA 1,0,2 ADD 1,0 ; NEXT ENTRY ADDRESS STA 0,0,2 ; RESET FOR NEXT PASS MOV# 0,0,SNC ; ANYTHING IN THAT ONE? JMP .LOOP ; NO DSZ 1,2 NOP LDA 2,SSOSP,3 STA 1,SSAC2,2 W RTRN ; WRITE A SIX-WORD ENTRY TO TEMP BLOCK BUFFER ; WRITE FULL BLOCK TO ALPHA LIST TEMP FILE TML.TM ; FIRST WORD OF EACH BLOCK IS ENTRY COUNT FOR THE BLOCK ; AC0 - ADDRESS OF FILE ENTRY TO BE TRANSFERRED ; AC1 - BUFFER (AT ENTRY PTR) 0 WRALF: ISZ SSRTN,2 ; SET GOOD RETURN MOV 1,2 LDA 1,0,2 ; GET ACTUAL ENTRY ADDRESS C EMOV ; MOVE ONE ENTRY LDA 0,ENT ADD 0,1 ; ADDRESS OF NEXT ENTRY STA 1,0,2 ; REPLACE IN BUFFER ISZ 1,2 ; BUMP ENTRY COUNT FOR BLOCK DSZ -3,2 ; BLOCK FULL YET? RTRN ; NO W:kRFUL: LDA 1,-1,2 ; YES - WRITE IT ISZ -1,2 ; NEXT BLOCK NEXT TIME INC 2,0 ; ACTUAL BLOCK START C FLUSH ; WRITE THE BLOCK JMP SERR ; ERROR SUB 1,1 AINIT: STA 1,1,2 ; INITIAL ENTRY COUNT = 0 INC 0,0 ; ADDRESS OF FIRST ENTRY STA 0,0,2 ; KEEP IT FOR tuNEXT TIME LDA 1,FPB ; FILES PER BLOCK CONSTANT STA 1,-3,2 ; REINITIALIZE ENTRIES TO GO RTRN 0 WRFB: ISZ SSRTN,2 ; WRITE FINAL BLOCK IF NOT FULL MOV 0,2 ; MAKE BUFFER ADDRESS LDA 1,1,2 ; GET ENTRY COUNT MOV# 1,1,SZR ; ANYTHING THERE? JMP WRFUL ; YES - FINISH IT OFF RTRN ; NO - JUST SKIP IT TCHDX: TCH+400 ; MOVE A FILE ENTRY ; AC0 - ADDRESS OF FROM FILE ; AC1 - ADDRESS OF TO FILE 0 EMOV: MOV 0,2 ; MAKE ADDRESSES ADDRESSABLE MOV 1,3 LDA 1,CM6 ; ENTRY SIZE IN WORDS LDA 0,0,2 ; GET A WORD S4TA 0,0,3 ; PUT A WORD INC 2,2 ; MOVE EVERYTHING UP INC 3,3 INC 1,1,SZR ; COUNT THEM AS THEY GO BY JMP .-5 RTRN ; WRITE OUT A BLOCK TO ALPHA FILE ; AC0 - ADDRESS OF BUFFER ; AC1 - LOGICAL BLOCK# 0 FLUSH: ISZ SSRTN,2 ; SET GOOD RETURN LDA 2,TCHDX ; CHANNEL+1BLOCK INCREMENT S WRB CPU JMP SERR ; TAKE ERROR RETURN RTRN 0 ALSF: MOV 0,2 SUB 1,1 STA 1,-1,2 LDA 0,TCHDX ; GET REAL CHANNEL# STA 0,-2,2 INC 2,0 JMP AINIT ; GO SET UP BUFFER ; GET ADDRESS OF NEXT SEQUENTIAL ENTRY ; MOVE TO NEW BLROCK AS NECESSARY ; AC0 - ADDRESS OF ITEM INFORMATION BLOCK ; AC2 - RETURNS ADDRESS OF NEXT ENTRY 0 BSTEP: ISZ SSRTN,2 MOV 0,2 ; MAKE INFO ADDRESSABLE LDA 1,ELFT,2 ; ENTRIES LEFT IN THIS BLOCK MOV# 1,1,SZR JMP MX LDA 1,LOGB,2 ; CURRENT BLOCK MOV1# 1,1,SNR ; GET NEXT BACK UNLESS ALREADY AT 0 JMP LEOF ; SAME AS EOF LDA 3,SSOSP,3 ; CALLING ROUTINES STACK POINTER LDA 2,@TMP,3 ; OTHER INFO BLOCK STA 2,TMP,3 ; SWAP BUFFERS BY SWITCHING THE WHOLE WORKS ADC 0,0 ADD 0,1 ; NEW BLOCK IS BACK ONE LDA s3,OBUF,2 ; ADDRESS OF FROZEN BUFFER INFO STA 0,ENTAD,3 ; FLAG BUFFER BUBBLED OVER MOV 2,0 C CHBLK ; PUT UP NEW BLOCK JMP SERR LDA 1,@BUFP,2 ; REFRESH ENTRIES LEFT STA 1,ELFT,2 ; EQUALS TOTAL IN BLOCK LDA 1,TOTSZ ; OFFSET TO LAST ENTRY JMP NX+1 LEuOF: LDA 2,EOFCD ; END-OF-FILE SERR: LDA 3,SSOSP,3 ; RECOVER OLD STACK POINTER DSZ SSRTN,3 ; SET FOR ERROR RETURN STA 2,SSAC2,3 ; RETURN CODE TO CALLER IN AC2 RTRN ; AND EXIT. 0 STEP: ISZ SSRTN,2 MOV 0,2 ; MAKE INFO ADDRESSABLE LDA 1,ELFT,2 ; GET EHNTRIES AVAILABLE MOV# 1,1,SZR ; ANY LEFT UNSAMPLED? JMP NX ; STILL SOME LEFT IN THIS ONE LDA 1,LOGB,2 INC 1,1 ; MOVE TO NEXT BLOCK FORWARD C CHBLK ; GET NEXT BLOCK IN JMP SERR LDA 1,@BUFP,2 ; RESET ENTRIES LEFT STA 1,ELFT,2 LDA 0,ENTAD,2 ; GET ADDR OF FIRST ENTRY JMP GENT MX: LDA 1,ENT ; NEGATIVE ENTRY SIZE NEG 1,1,SKP NX: LDA 1,ENT ; FILE ENTRY SIZE LDA 0,ENTAD,2 ; GET CURRENT ENTRY ADDR ADD 1,0 ; NEW ADDRESS STA 0,ENTAD,2 ; NEW ENTRY ADDRESS GENT: DSZ ELFT,2 ; COUNT OFF AN ENTRY NOP } LDA 2,SSOSP,3 STA 0,SSAC2,2 ; RETURN NEW ADDRESS IN AC2 RTRN TOTSZ: SCFNL*42.-SCFNL FPB: 42. EOFCD: EREOF ENT: SCFNL ; CHANGE BLOCK TO NEXT BLOCK FORWARD OR BACK ; WRITE CURRENT BLOCK IF MODIFIED ; UNSHARE BUT DONT WRITE SHARED BLOCK ; AC0 - ADDRESS OF THIS ITEM INFO BLOCK ; AC1 - REQUESTED BLOCK# ; INFO BLOCK DISPLACEMENTS: OBUF=0 ; ADDRESS OF OTHER ITEM INFO BLOCK BUFP=1 ; ADDRESS OF DATA BUFFER ENTAD=2 ; CURRENT ENTRY ADDRESS IN BUFFER LOGB=3 ; CURRENT BLOCK# ELFT=4 ; ENTRIES LEFT (AVAXILABLE) ; DATA BUFFER DISPLACEMENTS: SHARE=-2 ; SHARED BUFFER FLAG (FREE BUFF ADDR) STATS=-1 ; MODIFIED STATUS ; TOTAL ENTRY COUNT = 0 ; FIRST ENTRY = 1 AD=1 ; TEMPORARY FOR INFO ADDR AD CHBLK: ISZ SSRTN,2 MOV 0,2 LDA 0,LOGB,2 ; CURRENT BLOCK# SMUB# 0,1,SNR ; REQUESTED BLOCK SAME AS THERE NOW? RTRN ; YES - JUST GO BACK STA 1,LOGB,2 ; UPDATE BLOCK# STA 2,AD,3 LDA 3,BUFP,2 ; BUFFER ADDRESS LDA 1,SHARE,3 ; SHARE FLAG MOV# 1,1,SZR ; BOTH ITEMS IN SAME BLOCK? JMP SHARD ; YES - CANT RELEASE IT Y/ET LDA 1,STATS,3 ; STATUS WORD MOV# 1,1,SNR ; HAS IT BEEN MODIFIED? JMP GET ; NO - DONT BOTHER WRITING MOV 0,1 ; YUP - REPLACE IT IN THE FILE MOV 3,0 ; WRITE CURRENT MODIFIED BLOCK C FLUSH ; ROLL IT OUT JMP SERR GET: LDA 1,LOGB,2 ; BLOCK# IN vwNOW LDA 3,OBUF,2 ; ADDRESS OF OTHER ITEM INFO BLOCK LDA 0,LOGB,3 ; OTHER GUY'S BLOCK# SUB# 0,1,SNR ; DOES HE HAVE IT? JMP NSHARE ; YES - SHARE IT THEN GETB: LDA 0,BUFP,2 ; BUFFER ADDRESS MOV 0,3 SUB 2,2 ; CLEAR BUFFER STATUS BEFORE READING STA 2,SgTATS,3 ; BUFFER MODIFIED FLAG LDA 2,TCHDX ; CHANNEL S RDB CPU JMP SERR LDA 2,AD,3 ; INFO ADDRESS INC 0,0 ; ADDRESS OF FIRST ENTRY AVAIL: STA 0,ENTAD,2 ; INITIALIZE FOR THIS BLOCK RTRN SHARD: MOV 1,0 ; UNSHARE THIS BUFFER STA 0,BUFP,2 ; SHARE FLAG͂ BECOMES NEW BUFFER AD SUB 1,1 STA 1,SHARE,3 ; CLEAR SHARE FLAG FOR SHARED BUFFER LDA 1,LOGB,2 ; NEW BLOCK# JMP GETB+1 ; GO READ A NEW BLOCK NSHARE: LDA 3,BUFP,3 ; OTHER GUY'S BUFFER ADDRESS LDA 0,BUFP,2 ; NEWLY FREED BUFFER ADDRESS STA 3,BUFP,2 ; S/HARE THE SAME BUFFER NOW STA 0,SHARE,3 ; SHARE FLAG = FREE BUFFER ADDR INC 3,0 ; ADDRESS OF FIRST ENTRY JMP AVAIL ; GO SET ENTRIES AVAILABLE TO THIS ONE ; REPOSITION BLOCK ; AC1 - ITEM# ; ITEM# IS POSITIVE IF THIS IS NEW PASS THROUGH SORT AND POSITnION ; IS TO BE RELATIVE TO THE BEGINNING OF THE FILE ; ITEM# IS NEGATIVE IF THIS IS REPOSITION AFTER A BUBBLE UP AND ; POSITION IS TO BE RELATIVE TO THE CURRENT POSITION 0 REPOS: ISZ SSRTN,2 MOV 0,3 MOVL# 1,1,SNC ; ITEM POS OR NEG? JMP BREL ;p* POS - RELATIVE TO BEGINNING NEG 1,2 ; NEGATIVE - START WITH CURRENT BLOCK LDA 1,ELFT,3 ; ENTRIES STILL IN THIS BLOCK SUBZ 1,2,SEZ ; COUNT THOSE FIRST JMP CNTBK ; MORE NEEDED ADD 1,2 ; STILL IN THIS BLOCK SUB 2,1 ; NEW REMAINDER LDA 0,ENTAD,3 ; CBURRENT ENTRY POSITION JMP BKPOS ; GO POSITION WITHIN BLOCK CNTBK: NEG 2,2 ; CROSSED BLOCK BOUNDARY IN RELATIVE POS COM 2,2 ; ITEM# NOW RELATIVE TO 0, NOT 1 LDA 1,LOGB,3 JMP BREL+2 BREL: MOV 1,2 ; ENTRIES TO GO FORWARD ADC 1,1 ; BEGIN WITH BLOCK 0 LDA 3,FPB ; FILES PER BLOCK CONSTANT INC 1,1 ; COUNT BLOCKS PASSED SUBZ 3,2,SZC ; SUBTRACT OFF ANOTHER BLOCKS WORTH JMP .-2 ADD 3,2 ; WENT PAST IT C CHBLK ; NOW GET BLOCK WHERE ITEM RESIDES JMP SERR MOV 0,3 LDA 0,BUFP,3 ; BEGINNING OF BUFFER ,INC 0,0 ; FIRST ENTRY ADDR LDA 1,@BUFP,3 ; BLOCK ENTRY COUNT ADCZ 2,1,SNC ; TAKE OFF REMAINDER, COUNTING THIS PASS JMP LEOF ; NOT ENOUGH BKPOS: STA 1,ELFT,3 ; RESTORE ENTRIES AVAILABLE COUNT NEG 2,2,SNR ; MAKE ITEM# NEG FOR COUNTING JMP FENT LDA 1,E7FNT ; ENTRY SIZE ADD 1,0 ; MOVE CURRENT ENTRY ADDRESS UP INC 2,2,SZR ; UNTIL POSITIONED AT REQUESTED ENTRY JMP .-2 FENT: STA 0,ENTAD,3 ; KEEP THE FINAL ONE RTRN ; COMPARE ENTRIES FOR ALPHABETIC PRECEDENCE ; AC0 - ADDRESS OF FIRST ENTRY ; AC1 - ADDRES7S OF SECOND ENTRY ; C RANK ; -RETURN EQUAL OR 1ST SHOULD PRECEDE 2ND ; -RETURN 2ND SHOULD PRECEDE 1ST (SWITCH REQUIRED) WCNT=1 R2AD=WCNT+1 R2AD RANK: MOV 0,2 ; MAKE FIRST ADDRESSABLE LDA 0,ENT ; ENTRY SIZE STA 0,WCNT,3 ; KEEP IN STACK STA 1,R2AD,3> ; MAKE SECOND ADDRESSABLE .RLP: LDA 0,0,2 ; GET A WORD FROM EACH LDA 1,@R2AD,3 SUBZ# 1,0,SNC ; COMPARE WORDS RTRN ; 2ND LARGER - YOURE OUT SUB# 1,0,SZR ; 1ST LARGER OR EQUAL? JMP SRET ; 1ST LARGER - TAKE SWITCH RETURN INC 2,2 ; EQUAL - TRY NEXT WOiRD ISZ R2AD,3 ; BUMP ADDRESSES DSZ WCNT,3 ; COUNT AS THEY GO BY JMP .RLP RTRN ; TAKE NOSWITCH RETURN SRET: LDA 2,SSOSP,3 ISZ SSRTN,2 RTRN 0 GARBU: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS C BFMVO ; MOVE ARG TO USER SPACE LDA 2,SSOSP,3 ; RESTORE STACKL POINTER STA 0,SSAC0,2 ; RETURN POINTER TO CALLER LDA 0,SSAC1,2 ; GET FIRST BYTE OF ARG C LDBT LDA 0,C200 SUB# 0,1,SZR ; END OF FILE ?? ISZ SSRTN,2 ; NO GIVE NORMAL RETURN RTRN C200: 200 ; END OF FILE INDICATOR CLI63.KSRR k/ COPYRIGHT (C) DATA GENERAL CORPORATION, 1972, 1973, 1974, 1975, / 1977, ALL RIGHTS RESERVED. / / LICENSED MATERIAL - PROPERTY OF DATA GENERAL CORPORATION. / / / KEYSHEET FOR MODEL NUMBER 3192/3447 / / / PRODUCT NAME: RDOS CLI / / KEYSHEET NAME: CLI63.KS ~/ / / ALL CLI SOURCE(.SR) MODULES ARE INCLUDED IN THE "MAC" / STATEMENTS UNDER THE "ASSEMBLY PROCEDURE" SECTION(FOLLOWING). / THESE STATEMENTS CAN BE CONSIDERED THE COMPONENTS LIST / AND SHOULD BE USED FOR REFERENCES PURPOSES. / / TO BUILD THE CLI FROM THmE SOURCES, THE FOLLOWING GENERAL / PROCEDURE IS RECOMMENDED: / / 1. BRING UP YOUR CURRENT RDOS SYSTEM. / 2. CREATE A SUBDIRECTORY FOR THE NEW CLI: / / CDIR REV6SYSTEM / / 3. MAKE IT CURRENT: / / DIR REV6SYSTEM / / 4. LOAD THE SOURCES FROM THE SOURCE TAPE / 5. CREATE THE OPTIONS FILE(SEE BELOW). / 6. EXECUTE THIS KEYSHEET TO BUILD THE CLI, / USING THE CLI INDIRECT CONVENTION. / 7. THE CLI IS NOW BUILT / /**********************NOTE*****************NOTE*********************** / THIS KEY SHEET MWUST BE EXECUTED IN A SUBDIRECTORY SINCE IT CREATES / CLI.SV CLI.OL CLI.ER WHICH WILL BE IN USE ON THE PRIMARY PARTITION / / / BEFORE USING THESE COMMAND LINES YOU MUST CREATE A FILE CALLED OPTIONS / WHICH CONTAINS THE LISTING FILE AND THE ERROR FILE IF ANY!. YOU CAN DO THIS / BY TYPING: / XFER/A $TTI OPTIONS / MT0:0/L $LPT/E ^Z / / NOTE THE FILE OPTIONS MUST NOT CONTAIN A CARRIAGE RETURN. IT IS ENDED / BY TYPING A (CONTROL Z) / / IF ANY OF THE OPTIONS ARE DEVICES (I.E. MAG TAPE) THE DEVICES MUST / BE INITXED BEFORE THIS KEY SHEET IS EXECUTED. / / THESE PROCEDURES ASSUME THAT YOU HAVE THE FOLLOWING / FILES ON THE PRIMARY PARTITION OF THE DISK. / / MAC.SV / MACXR.SV / RLDR.SV / RLDR.OL / SYS.LB / NBID.SR / OSID.SR / NSKID.SR / PARU.SR / /***************************************************************** / LINK THE FILES WE NEED SINCE WE ARE IN A SUBDIRECTORY / UNLINK -.- LINK MAC.SV/2 MACXR.SV/2 RLDR.SV/2 RLDR.OL/2 SYS.LB/2 NBID.SR/2 OSID.SR/2 ^ NSKID.SR/2 PARU.SR/2 / /***************************************************************** / / ASSEMBLY PROCEDURE: / / / FIRST GET RID OF ANY OLD MAC.PS / DELETE MAC.PS / / CREATE A NEW MAC.PS / MAC/N/Z/F NBID/S OSID/S PARU/S NSKID/S CLIPARS @OPTIONS@ / MAC/S/N NBID,OSID,PARU,NSKID,CLIPARS / MAC/F/Z (CL4I,WRLIN,FPRINT,BCHAR,INSEF,RDLIN,^ GETLI,PRESCAN,XPAND,TIMR,OVREV,CHATR,ERROR,FSERR,^ CLEAR,CNAME,COMS,DELETE,DUMP,DUM2,EXEC,LIST,LIS2,^ LOAD,MOVE,MOV2,MKABS,MKSAV,PARTH,XFER,FILCOM,^ TUNE,BUILD,MKNMS,CNVRT,CCI,GSUBR,BSPAS,BDPAS,^ ASCB,ASCD,VRFIL,LINKA,GETj>CR,INSTX,MACEX,^ MESSAGE,WFGND,EXPAR,OVSBRS) @OPTIONS@ / /***************************************************************** / LOAD PROCEDURE: / / GET RID OF ANY OLD MOLDY CLI / DELETE CLI.SV CLI.OL CLI.ER / RLDR/P @OPTIONS@ CLI CCI CGETLI ^ CBCHAR CRDLIN CXWRLIN CGSUBR CBSPAS CBDPAS ^ CASCB CASCD CVRFIL CLINKA CFSERR CTIMR ^ [COVREV CCHATR CCOMS,CCLEAR CCNAME CDUMP,CEXEC,CLIST CWFGND CMESSAGE,CLOAD,^ CMKABS CMKSAV CPARTH CXFER CFILCOM,CTUNE,CBUILD CDELETE CCNVRT CMKNMS,^ CMOVE,CFPRINT,CMOV2,CLIS2,CDUM2,^ CIN xSEF CGETCR CINSTX CPRESCAN CXPAND CEXPAR CMACEX COVSBRS] RLDR/C/P/N @OPTIONS@ CERROR XFER CERROR.SV CLI.ER/R / / /***************************************************************** / NOW CLEAN UP / DELETE CLI.RB,CCI.RB,CGETLI.RB,CINSEF.RB,CBCHAR.RB,CRDLIN.w"RB,CWRLIN.RB,^ CGSUBR.RB,CBSPAS.RB,CBDPAS.RB,CPRESCAN.RB,CXPAND.RB,CASCB.RB,^ CASCD.RB,CVRFIL.RB,CLINKA.RB,CFSERR.RB,CTIMR.RB,COVREV.RB,CCHATR.RB,^ CCOMS.RB,CCLEAR.RB,CCNAME.RB,CDUMP.RB,CEXEC.RB,CLIST.RB,CLOAD.RB,^ CMKABS.RB,CMKSAV.RB,CPARTH.RB,CXFER.RB,CFLILCOM.RB,CTUNE.RB,^ CBUILD.RB,CDELETE.RB,CCNVRT.RB,CMKNMS.RB,CMOVE.RB,CFPRINT.RB,^ CMOV2.RB,CLIS2.RB,CDUM2.RB,CGETCR.RB,CINSTX.RB,CMACEX.RB,^ CMESSAGE.RB,CWFGND.RB,CEXPAR.RB,COVSBRS.RB,^ CERROR.RB,CERROR.SV,OPTIONS / /**************************************(*************************** / CLI BUILT CCI.SR5 ! ; ; EXECU- ; EXPAND COMMAND IN COMMAND BUFFER INTO CLI FORMAT ; AND THEN INVOKE PROPER ROUTINE TO PERFORM COMMAND. ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CCI .RB CCI.RB ** .ENDC J .TITL BCI .RB BCI.RB **[J] .NREL .TXTM 1 ; PACK EM LEFT TO RIGHT .ENT EXECU ; ENTRY TO EXECUTE COMMAND .ENT EXER ; EXECUTE ERROR ROUTINE FOR EXEC .ENT SWAPR ; ENTRY POINT TO CHAIN AN OVERLAY .EXTN SPYF ; LOG FILE FLAG .EXTN LOGER ; LOG FILE ERROR HANDLER .EXTN CALL RTRN RCALL ; LINKAGE ROUTINES .EXTN LDBT STBT ; BYTE ROUTINES .EXTN INDEX ; FIND A CHARACTER .EXTN COMP ; STRING COMPARE .EXTN GETARG ; NEXT ARG .EXTN GETSW ; GET SWITCHES .EXTN CBUFR ; COMMAND BUFFER ADDRESS .EXTN CMDER ; COMMAND ERROR ROUTINE .EXTN CLIRS ; CLI RESTART ROUTINE .EXTN TRACE ; LOG FILE TRACE ROUTINE .EXTN GCBUF ; GET CHARACTER ROUTINE .EXTN INAME ; CON IN NAME .EXTN GETMC ; MACRO RETURN ADDRESS .EXTN GTPSH ; PUSH RETURN ADDRESS ; ; COMMAND PRO^,GRAMS ; .EXTN DELET ; DELETE A FILE ENTRY .EXTN CLEAR ; CLEAR DIRECTORY USER COUNT .EXTN CHATR ; CHANGE ATTRIBUTES .EXTN CHLAT ; CHANGE LINK ATTRIBUTES .EXTN MKSAVE ; SAVE FILE MAKER .EXTN CREA ; CREATE .EXTN CRAN ; CRAND .EXTN CDIR ; CREATE DIRECTORY FILE .EXTN CPAR ; CREATE PARTITION .EXTN GMEM ; GET BG/FG MEMORY ALLOCATION .EXTN SMEM ; SET BG/FG MEMORY ALLOCATION .EXTN BOOT ; BOOTSTRAP UP A NEW SYSTEM .EXTN CCON ; CREATE CONTIGUOUS .EXTN XFER ; XFER .EXTN LIST ; DIR LISTER .EXTN RENAM ; RENAME .EXTN APPEND ; APPEND .EXTN EXEC ; COMMAND FILE BUILDER .EXTN LOAD ; FILE LOADER .EXTN DUMP ; FILE DUMPER .EXTN SPACE ; DISK SPACE INQURY .EXTN MKNAM ; NAME MAKER .EXTN CKMAB ; MAKE ABS. .EXTN PRINT ; DISK FILE TO LPT .EXTN TYPE ; DISK FILE TO TTO .EXTN PUNCH ; DISK FILE TO PTP .EXTN BPUNCH ; DISK FILE TO PTP (BINARY) .EXTN SQUAS ; INSTALL A NEW SYSTEM .EXTN INITC,RLSEC ; INIT AND RELEASE A DEVICE .EXTN DIR ; CHANGE DIRECTORY .EXTN STOD,GTOD,SDAY .EXTN SPEBL,SPKIL,SPDIS ; SPOOLER COMMANDS .EXTN SPY,KSPY ; KEEP RUNNING TAB ON CONSOLE .EXTN REPLACE ; CHANGE OVERLAY IN OVERLAY FILE .EXTN LINK ; MAKE LINK ENTRY IN SUBDIRECTORY .EXTN UNLINK ; DELETE A LINK ENTRY .EXTN EQUIV ; RENAME DIRECTORY .EXTN GDIR ; GET CURRENT DIRECTORY SPECIFITER .EXTN LDIR ; GET NAME OF PREVIOUS DEFAULT DIRECTORY .EXTN MDIR ; GET MASTER DIRECTORY SPECIFIER .EXTN GSYS ; GET CURRENTLY RUNNING SYSTEM NAME .EXTN FILCOM ; FILE COMPARER .EXTN REVNO ; REVISION NUMVER .EXTN PPOP ; POP FROM A PUSH .EXTN TUON ; TUNING ON .EXTN TUOFF ; TUNING OFF .EXTN TPRINT ; PRINT THE TUNING FILE .EXTN DOT ; DATE SWITCH .EXTN MOVEF ; MOVE FILES ROUTINE .EXTN BUILD ; BUILD COMMAND LINE .EXTN FPRINT ; FORMATTED PRINT .EXTN MESSAGE ; WRITE TEXT STRING TO OUTPUT CONSOLE .EXTN WFGND ; WRITE FOREGND STATE TO OUTPUT CONSOLE ; ; STACK VARIABLES ; TMP= 1 ; TEMP CP= TMP+1 ; CURRENT COMMAND POINTER OP= CP+1 ; RUNNING OUTPUT POINTER BRMOD= OP+1 ; BRACKET MODE MODE= BRMOD+1 ; ARG/SW MODE MS= MODE+1 ; MULTI SPACE IGNORE MODE SWP= MS+1 ; SWP -> S12 NAMP= SWP+1 ; NAMP -> NAME IPP= NAMP+1 ; INPUT POINTER S12= IPP+1 ; SWITCHES S34= S12+1 RNUM= S34+1 ; NUMERIC SWITCH COUNT TEXT= RNUM+1 ; TEXT MODE SWITCH ARGP= TEXT+1 ; POINTER TO CURRENT ARGUMENT CMCD= ARGP+1 ; COMMAND CODEG: NAME= CMCD+1 ; NAME SPACE BUFF= NAME+40 ; LINE BUFFER FRAME= BUFF ; FRAME SIZE FRAME EXECU: LDA 2,USTP ; AC2 => UST LDA 0,USTPC,2 MOV# 0,0,SNR ; FG ?? JMP EXEC1 ; BACKGROUND LDA 0,ECIAD ; FOREGROUND STA 0,@ETBAD ; RESET EXEC CORE IMAGE ADDRESS [ LDA 0,FCMLS ; AND COMMAND LIST STA 0,@FCLD ; FOR DURATION OF THIS CLI EXEC1: BPT S12 SWP,NAME NAMP CLER S12 S34 RNUM MODE MS BRMOD TEXT BPT BUFF CP ; INITIALIZE COMMAND POINTER AND STA 1,OP,3 ; OUTPUT POINTER STA 1,ARGP,3 ; LAST ARG PTR FOR REPEATS eLDA 2,.CBUFR ; SET UP INPUT POINTER LDA 0,BFRPT,2 STA 0,IPP,3 ; GET CHARS FROM CBUF AND PROCESS CINS: LDA 0,IPP,3 ; PICK UP INPUT POINTER LDA 2,.CBUFR ; GET NEXT CHARACTER FROM CBUF C GCBUF ISZ IPP,3 ; BUMP INPUT POINTER BADSW: DISP MAINT ; DISPATCMH ON CHARACTER MAINT: .+1 ; CHARACTER DISPATCH TABLE 40 ; SPACE SPAC SEMI CARR ; SEMI COLON "/ SLSH ; SWITCH DELEMITER EOL CARR ; CARR RETRN ", COMMA "[ LBRK "] RBRK 42 ; QUOTE (") TEXTM ; FLIP TEXT MODE SWITCH -1 ; END 1OF TABLE ANYCH ; CARRIAGE RETURN HANDLER CARR: LDA 1,BRMOD,3 MOVZ 1,1,SZR JMP .BRER C MKNUL ; NULL THERE ?? JMP .+4 ; YES LEAVE ALONE SUBO 1,1 ; NO STORE ONE C STMUD LDA 1,C377 ; AC1 <= EOF JMP @ENDAP ; QUOTE HANDLING (") TEXTM: LDA 0{",TEXT,3 ; PICK UP TEXT MODE SWITCH COM 0,0 ; FLIP IT AND STA 0,TEXT,3 ; STORE IT BACK. JMP CINS ; GET NEXT CHARACTER ; COMMA HANDLER COMMA: C CHKTX ; ARE WE IN TEXT MODE? JMP ANYCH ; YES- TREAT AS NON-SPECIAL LDA 0,BRMOD,3 ; LOOK AT BRACKET MODE QSWITCH MOV# 0,0,SNR ; IF NOT IN BRACKET MODE THEN JMP @.SPAC ; GO TO SPACE HANDLER ELSE LDA 0,LBK ; PREVIOUS CHARACTER MUST C CKPRV ; NOT BE LBK OR THERE IS JMP .BRER ; A BRACKET ERROR JMP SD1 .CBUFR: CBUFR C377: 377 ECIAD: @FGNDL ETBAD: ENTAB FCxMLS: FCMTB FCLD: CMADR .SPAC: SPAC LBK: "[ ; SPACE HANDLING SPAC: C CHKTX ; ARE WE IN TEXT MODE? JMP ANYCH ; YES- TREAT AS NON-SPECIAL LDA 2,MS,3 ; LOOK AT SPACE MODE MOV# 2,2,SNR JMP CINS ; IGNORE SPACE SUB 1,1 ; CLEAR AC C STMUD ; OUTPUT A NULL STA 1,MS,3 ; ENTER IGNORE SPACES MODE STA 2,MODE,3 JMP CINS ; NON-SPECIAL CHARACTER HANDLING ANYCH: LDA 2,MODE,3 ; LOOK AT MODE MOVO 2,2,SNR JMP AAM ; ARG MODE SUBC 2,2 ; SW MODE STA 2,MODE,3 ; ENTER ARG MODE JMP @ENDAP ; SQUARE BRACKET - PROCESS AS FILENAME LBRK: C CHKTX ; ARE WE IN TEXT MODE? JMP ANYCH ; YES- TREAT AS NON- SPECIAL LDA 2,BRMOD,3 MOV# 2,2,SZR JMP .BRER ; ALREADY SEEN ONE STA 1,BRMOD,3 ; SET BRACKET MODE JMP SDA ; GO PROCESS RBRK: C CHKTX ; ARE WE IN TEXT MODE? JMP ANYCH ; YES- TREAT AS NON-SPECIAL LDA 2,BRMOD,3 MOV# 2,2,SNR JMP .BRER LDA 0,CMA C CKPRV ; PRECEEDING COMMA? JMP .BRER ; NO GOOD SDA: LDA 2,MS,3 MOV# 2,2,SZR JMP SD1 LDA 2,MODE,3 ; CHECK MODE MOVZ 2,2,SNR JMP AAM SD1: STA 1,TMP,3 STA 1,MODE,3 ; SET ARG MODE C MKNUL ; NULL THERE ?? JMP .+4 ; YES LEAVE ALONE SUBO 1,1 ; NO STORE ONE C STMUD LDA 1,TMP,3 ; GET BACK CHARACTER JMP @ENDAP ; FINISH OFF PREVIOUS ARG ; IN ARGUMENT MODE AAM: C STMUD ; STORE MUD BYTE STA 1,MS,3 ; TURN OF IGNORE SPACES MODE MOV# 0,0,SZC ; DID WE COME FROM ANYCH? JMP @PCIN ; YES- GO TO MAIN INPUT LOOP LDA 0,BRMOD,3 ; NO- ARE WE IN BRACKET MODE? MOV# 0,0,SZR ; IF WE ARE IN BRACKET MODE JMP BRK1 ; PROCESS BRACKET ELSE JMP @SBCMP ; GO EXECUTE COMMAND ; PROCESS BRACKET BRK1: MOV 1,2 SUB 1,1 LDA 0,RBR SUB# 0,2,SZR JMP BRK2 STA 1,BRMOD,3 ; TURN OFF BRACKET MODE BRK2: STA 2,MODE,3 ; SET SWITCH MODE STA 1,MS,3 ; IGNORE SPACES STA 1,S12,3 LDA 2,BSW STA 2,S34,3 C STMUD JMP @PCIN .BRER: LDA 2,.CSYER w; BRACKET ERROR ER2 ; GIVE ERROR RTRN ; BYE BYE ENDAP: ENDARG SWMAX: "Z SWMIN: "A-1 RBR: "] CMA: ", BSW: 1B10 .CSYER: CSYER ; BRACKET ERROR SBCMP: SUBCM PCIN: CINS ; SLASH HANDLING SLSH: C CHKTX ; ARE WE IN TEXT MODE? JMP @.ANYCH ; YES- TREAT A S NON-SPECIAL LDA 0,MODE,3 ; MODE ? MOV# 0,0,SZR JMP SWMD ; / IN SWITCH MODE C MKNUL ; NULL THERE ?? JMP .+4 ; YES LEAVE ALONE SUBO 1,1 ; NO STORE ONE C STMUD STA 1,MS,3 ; IGNORE SPACES STA 2,MODE,3 ; ENTER SW MODE SWMD: LDA 0,IPP,3 LDA 2,..CBUF C GCBUF ISZ IPP,3 LDA 2,SWMIN LDA 0,SWMAX SUBZ# 1,2,SNC ; IN RANGE A - Z ?? SUBZ# 1,0,SNC JMP BADSP ; NO CHECK IF NUMERIC SUB 1,2 ; YES PUT IN RANGE SUB 0,0 ; CLEAR AC0 AND AC1 SUBZ 1,1 ; SET CARRY SWMD1: MOVR 0,0 ; SHIFT IN PROPER BIגT MOVR 1,1 INC 2,2,SZR ; DONE ?? JMP SWMD1 LDA 2,S12,3 ; YES "OR" TO EXISTING SWITCHES AND# 0,2,SNR ; QUICK AND DIRTY ADD 0,2 STA 2,S12,3 LDA 2,S34,3 AND# 1,2,SNR ADD 1,2 STA 2,S34,3 MOVZ 0,0 JMP @PCIN BADSP: MOV 1,2 ; AC2 <= NUMERIC SWITCmH LDA 0,C60 ; CHECK IF SWITCH SUB 0,2 ; IS BETWEEN ASCII 0-9 LDA 0,C11 SUBZ# 2,0,SNC JMP @IGSW ; NO- BAD NUMERIC SWITCH LDA 0,RNUM,3 ; YES- ADD IN THIS SWITCH ADD 0,2 STA 2,RNUM,3 JMP @PCIN ..CBUF: CBUFR IGSW: BADSW C11: 11 C60: 60 .ANYCH: ANYCH‚ ; END OF ARGUMENT FOUND ENDAR: MOVL 1,1 ; SAVE LAST CHAR AND CARRY STA 1,TMP,3 ; FLAG AT TMP. LDA 0,SWP,3 ; AC0 => LETTER SWITCHES LDA 2,C04 ; STORE 4 BYTES ENDA1: C LDBT ; OF LETTER SWITCHES C STMUD INC 0,0 INC 2,2,SZR JMP ENDA1 LDA 0,RNUM,3 ; AC0 <= NUMERIC SWITCH COUNT MOV# 0,0,SNR ; IF NO REPEATS JMP NORPT ; THEN NOTHING MORE TO DO DSZ RNUM,3 ; ELSE DECREMENT COUNT. JMP RLP2 ; IF SW > 1 THEN PROCESS JMP NORPT ; ELSE DON'T BOTHER. RLP2: LDA 0,ARGP,3 ; AC0 => ARGUMENT RLP21: C LDBT ; STORE ARGUMENT AGAIN C STMUD ; IN MUD BUFFER INC 0,0 ; INCLUDING TERMINATING NULL MOV# 1,1,SZR JMP RLP21 LDA 0,SWP,3 ; THEN REPEAT THE 4 SWITCH BYTES. LDA 2,C04 RLP22: C LDBT C STMUD INC 0,0 INC 2,2,SZR JMP RLP22 DSZ RNUM,3 ; LAST REPEAT? JMPԯ RLP2 ; NO- REPEAT ARGS + SWS AGAIN NORPT: STA 2,S12,3 ; YES- REINITIALIZE STA 2,S34,3 ; ALPHA SWITCH WORDS. LDA 1,OP,3 ; MAKE RUNNING OUTPUT POINTER STA 1,ARGP,3 ; NEW ARGUMENT POINTER LDA 1,TMP,3 ; PICK UP LAST CHAR MOVZR 1,1 ; RESTORE IT + CARRY FLAG JMP @NORPR ; AND CONTINUE PROCESSING NORPR: AAM C04: -4 ; CHECK IF NULL NEEDED 0 MKNUL: LDA 0,OP,2 LDA 1,CP,2 SUB 0,1,SNR JMP SNL NEG 0,0 COM 0,0 C LDBT MOV# 1,1,SZR SNL: ISZ SSRTN,2 ; NULL IS NEEDED RTRN ; CHECK PREVIOUS CHARACTER 0 CKPRV: ISZ SSRTN,2 ; SET NO MATCH RETURN LDA 0,IPP,2 SUBZL 1,1 CKPR1: ADC 1,0 LDA 2,..CBUF C GCBUF MOV 1,1,SNR JMP CKPR1 LDA 2,SSOSP,3 LDA 0,SSAC0,2 ; AC0 <= INPUTTED CHARACTER SUB# 1,0,SNR ; IF PREVIOUS MATCHES INPUTTED DSZ SSRTN,2 ; TAKE MATCH R0ETURN ELSE RTRN ; TAKE NO MATCH RETURN ; CHECK IF IN TEXT MODE 0 CHKTX: LDA 0,TEXT,2 ; PICK UP TEXT MODE SWITCH MOV# 0,0,SNR ; ARE WE IN TEXT MODE? ISZ SSRTN,2 ; NO- BUMP RETURN RTRN ; STORE "MUD" BYTE IN EXPANDING STACK BUFFER 0 STMUD: LDA 0,OP+],2 ; PICK UP OUTPUT POINTER MOVR# 0,0,SZC ; ARE WE AT END OF WORD? ISZ SSLGT,2 ; YES- BUMP CALLER'S STACK LENGTH C STBT ; STORE BYTE ISZ OP,2 ; BUMP OUTPUT POINTER RTRN ; ; LOCATE COMMAND IN COMMAND TABLE AND GO EXECUTE ; SUBCM: C TRACE ; TRACE C[OMMAND LINE IF NECESSARY LDA 0,CP,3 ; LINE POINTER ADC 1,1 ; INITIALIZE COMMAND CODE = -1 .SUBCM: STA 1,CMCD,3 ; SET COMMAND CODE LDA 1,CMADR ; COMMAND STRING ADDRESS STA 1,TMP,3 ; SAVE IN STACK ADC 2,2 ; INITIAL OVERLAY NUMBER NEXTC: LDA @1,TMP,3 ;. STRING PTR MOV 1,1,SZR ; 0 IS BEG. OF NEW OVERLAY JMP NEXT1 INC 2,2 ; BUMP OVERLAY# ISZ TMP,3 LDA @1,TMP,3 ; NOW STRING POINTER NEXT1: COM# 1,1,SNR ; -1 IS LAST ENTRY JMP NOMAT ; NO MATCH - TAKE DEFAULT CASE C COMP ; COMPARE STRINGS JMP FOUND ; @A MATCH ISZ TMP,3 ISZ TMP,3 ; BUMP POINTER JMP NEXTC NOMAT: ADC 0,0,SKP ; SET FLAG FOR NO OVERLAY FOUND: MOV 2,0 ISZ TMP,3 ; BUMP TABLE POINTER TO ADDRESS LDA @2,TMP,3 ; COMMAND ADDRESS COM# 0,0,SZR ; ROUTINE IN OVERLAY? JMP OVGET ; YES GO: LDA 1,CMCD,3 ; PASS COMMAND CODE LDA 0,CP,3 ; LINE POINTER MOVL# 2,2,SZC ; JMP OR CALL? JMP 0,2 RCALL NOP ; IGNORE ERROR RETURN RTRN ; DONE WITH THIS COMMAND EXSYS: LDA 2,EXC ; PICK UP EXEC OVERLAY ADDRESS LDA 0,EXOVN ; & OVERLAY NUMBER FOR EXFG SYSUTIL OVGET: SUB 1,1 ; CONDITIONAL LOAD S OVLOD OVCH ; READ THE OVERLAY JMP @.ER2X ; SOME ERROR JMP GO ; GO EXECUTE SWAPR: JMP OVGET FCOML: FCOMF*2 CMADR: CMTAB ; (OR FCMTB) EXC: EXEC EXOVN: 2 .ER2X: ER2X ; ; PROCESS USER SAVE/MACRO FILE ; FGNDL: LDA 0,FCOML ; .EXEC IN FG - FCOM.CM SUBZL 2,2 ; SET FLAG TO DO .EXEC JMP ENTYP ; JOIN COMMON PATH ENDL2: SUB 2,2,SKP ; SET FLAG FOR .EXFG USER FILE ENDLS: SUBZL 2,2 ; .EXEC IN BG - COM.CM LDA 0,FCOML ; PTR TO COM.CM ADD 2,0 ; COM.CM IF BG ENTYP: STA 2,TMOP,3 ; SET .EXEC/.EXFG FLAG S DELE ; DELETE OLD COMMAND FILE NOP S CREA ; CREATE NEW COMMAND FILE JMP ER1X S OPEN COMCH ; OPEN IT FOR WRITING JMP CMER ; OPEN ERROR LDA 0,CP,3 ; AC0 => COMMAND STRING LDA 1,OP,3 SUB 0,1 ; AC1 GETS COMMAND LENGTH S WRS COMCH ; WRITE COMMAND LINE JMP CMER S CLOS COMCH ; CLOSE COMMAND FILE JMP CMER LDA 1,CMCD,3 ; COMMAND CODE SEQM1 1 ; IF COMMAND CODE NOT -1 JMP BLD.SV ; CANNOT EXECUTE A MACRO. LDA 0,CP,3 ; AC0 => COMMAND FILE NAME LDA 1,KPER ; AC1 <= PERIODս C INDEX ; IS THERE AN EXTENSION? JMP CHKMC ; NO- CHECK IF THIS IS A MACRO LDA 1,SVP ; YES- AC1 => .SV C COMP ; IS EXTENSION .SV ? JMP BLD.SV ; YES- DON'T CHECK FOR MACRO ; CHECK IF MACRO FILE CHKMC: LDA 0,CP,3 ; PICK UP POINTER TO COMMAND LDA 1,=MCP ; PICK UP => .MC LDA 2,NAMP,3 ; AC2 => NAME SPACE C MKNAM ; FORM COMMAND.MC MOV 2,0 ; AC0 => NAME.MC S OPEN INSCH ; CAN IT BE OPENED? JMP NOTMC ; NOT MACRO FILE (POSSIBLY!!!!) LDA 2,SSOSP,3 ; RESTORE OLD STACK POINTER LDA 0,.GETMC ; AC0 <= RETfURN ADDRESS FOR MACROS STA 0,SSRTN,2 ; SET FOR MACRO RETURN RTRN ; SEE YOU LATER CMER: S CLOS COMCH ; CLOSE COMMAND CHANNEL NOP ER1X: ER1 ; REPORT THE ERROR RTRN ; DONE WITH THIS COMMAND .GETMC: GETMC ; PROCESS SAVE FILE BLD.SV: LDA 0,CP,3 ; AC0 => COMMAND FILE NAME NOTMC: LDA 1,SVP ; -> .SV LDA 2,NAMP,3 ; NAME SPACE C MKNAM ; BUILD NAME MOV 2,0 ; AC0 => NAME.SV LDA 1,CMCD,3 ; AC1 GETS COMMAND CODE COM 1,1,SZR ; -1 IS NORMAL CASE COM 1,1 ; SOMETHING SET- FLIP IT BACK LDA 2,@LOGF ; AC2w <= LOG FILE FLAG LDA 3,TSW ; AC3 <= TRACE SWITCH BIT AND# 2,3,SNR ; IF NOT TRACING JMP NOLOG ; THEN DON'T WORRY ABOUT LOG FILE S UPDAT KCH ; ELSE INSURE LOG FILE INTEGRITY. JMP @.LOGER ; FATAL ERROR !!! NOLOG: LDA 3,USP ; RECOVER STACK POINTER LDA 3px,TMP,3 ; PICK UP FLAG- MOV# 3,3,SNR ; IF = 0 THEN GO EXECUTE JMP FORG ; PROGRAM IN FG (EXFG) ELSE LDA 2,USTP ; SEE IF INFOS LDA 2,USTRV,2 ; LOOK IN ENVIR. STATUS WORD LDA 3,.ENINF AND 3,2,SZR ; IF INFOS THEN JMP INFOS ; HANDLE SPECIAL ELSE S EXEYC ; EXECUTE PROGRAM IN CURRENT GROUND JMP EXER ; SOME ERROR RTRN ; DONE WITH THIS COMMAND FORG: SUB 2,2 ; CLEAR AC2 FOR CALLED PROGRAM S EXFG ; EXECUTE PROGRAM IN FORGROUND JMP EXER ; SOME KIND OF ERROR RTRN ; DONE WITH THIS COMMAND ; SPECIAL IpNFOS HANDLING INFOS: S CLOS CIN ; CLOSE THE CONSOLE INPUT NOP SUB 2,2 ; CLEAR AC2 S EXEC ; EXECUTE PROGRAM IN CURRENT GROUND JMP IEXER ; ERROR- REOPEN INPUT CONSOLE C OPENC ; OPEN THE CON AGAIN RTRN ; DONE WITH THIS COMMAND IEXER: C OPENC ; O%PEN CON AGAIN JMP EXER ; GO HANDLE ERROR SVP: SVEP*2 MCP: MCEP*2 KPER: ". LOGF: SPYF TSW: T.SW .LOGER: LOGER ; ; COMMAND CODE BITS CODE ; BG - 1B15 DEBUG ; 1B0 CHAIN ; FG - 1B15 DEBUG ; 1B1 EQUAL PRIORITY FG ; ; PROCESS AN EXFG COMMANyD EXFGR: C GETSW ; GET SWITCHES STA 1,CMCD,3 ; SAVE SWITCHES S FGND ; SEE IF FG ALREADY RUNNING NOP MOV# 0,0,SZR ; IF FOREGROUND IS ALREADY RUNNING JMP FGER ; THEN WE ARE IN ERROR LDA 1,CMCD,3 ; RESTORE SWITCHES LDA 0,FGND ; AC0 = FORGROUND COMMAND LDA 2,ESW ; /E EQUAL PRIORITY FG AND# 1,2,SNR ; IS SWITCH ON? JMP EXFG1 ; NO- GO CHECK FOR /D LDA 2,EPCD ; YES- SET 1B1 ADD 2,0 ; INTO COMMAND WORD EXFG1: LDA 2,DSW ; /D DEBUG AND# 1,2,SNR ; IS SWITCH ON? JMP EXFG2 ; NO- SAVE COMMAND WORD AS IS  MOVR 0,0 ; YES- MOVOL 0,0 ; SET 1B15 IN COMMAND WORD EXFG2: STA 0,CMCD,3 ; REPLACE COMMAND CODE LDA 0,CP,3 ; RECOVER COMMAND POINTER C GETARG ; GET FILENAME JMP NOARG ; NONE- THAT'S NO GOOD STA 0,CP,3 ; SAVE FILENAME PTR LDA 2,FGAD ; TABLE OF FG EXE"QCS NXTF: INC 2,2 ; BUMP TABLE POINTER LDA 1,0,2 ; PICK UP SYSTEM UTILITY FILE NAME INC 2,2 ; BUMP TABLE POINTER MOV# 1,1,SNR ; END OF TABLE? JMP @.ENDL2 ; YES - USER SAVE FILE C COMP ; NO- SEE IF THIS IS IT JMP @.EXSYS ; MATCH - SYSTEM UTILITY FILE JMP NXTF ; NO MATCH- TRY NEXT FGER: LDA 2,FGRER ; AC2 = FOREGROUND ALREADY EXISTS JMP ER2X ; REPORT IT DSW: 1B3 ESW: 1B4 EPCD: 1B1 FGAD: FGTAB .ENINF: ENINF FGND: 1B7 FGRER: ERFGE .EXSYS: EXSYS .ENDL2: ENDL2 ; PROCESS CHAIN/DEBUG COMMANDS CHAIN: LDA 2,@LOGF ; LOG FILE FLAG SEQZ 2 ; IF LOG FILE OPEN JMP ERCHN ; THEN DON'T ALLOW CHAIN. C GETSW ; CHECK FOR /D STA 0,CP,3 ; SAVE POINTER TO CHAIN ARG SUBZR 0,0 ; SET CHAIN CODE = 1B0 LDA 2,DSW ; DEBUG SWITCH AND# 1,2,SZR ; IF USER REQUESTING DEBUG INC 0,0 ; THEN SET DEBUG CODE = 1B15. MOV 0,1 ; MOVE COMMAND CODE TO AC1 LDA 0,CP,3 ; RECOVER COMMAND STRING POINTER JMP CHARG ; GO GET CHAIN ARGUMENT DEBG: SUBZL 1,1 ; SET DEBUG CODE = 1B15 CHARG: C GETARG ; GET AN ARGUMENT JMP NOARG ; NOT THEREYV STA 0,CP,3 JMP @.+1 ; GO FIND REAL COMMAND .SUBCM ; PROCESS A SAVE COMMAND SAVE: C GETARG ; GET NEXT ARG JMP NOARG ; NEEDS ONE ARG AT LEAST LDA 1,SVP ; -> .SV EXT  LDA 2,NAMP,3 C MKNAM ; MAKE NAME.SV MOV 2,0 S DELE ; DELETE OLD ONE NOP MOV 0,1 LDA 2,USTP LDA 2,USTPC,2 ; FG OR BG? LDA 0,SVNP ; PTR TO FBREAK.SV MOV# 2,2,SNR INC 0,0 ; BG - PTR TO BREAK.SV S RENAME ; RENAME NEW ONE OLD ONE JMP @.ER1X ; REPORT ERROR RTRN ; DONE WITH THIS COMMAND ; PROCESS NULL COMMAND NEXT: RTRN ; THAΈT'S ALL ; HANDLE SOME PRE-EXEC ERRORS ERCHN: LDA 2,.ERCAN ; AC2 = YOU CAN'T DO THAT JMP ER2X ; REPORT ERROR NOARG: LDA 2,NOARM ; AC2 = NOT ENOUGH ARGS ER2X: ER2 ; REPORT ERROR RTRN ; DONE WITH THIS COMMAND NOARM: CNEAR .ERCAN: ERCANT ; PROCESS EXEC ERROR RETURN EXER: COM# 1,1,SNR ; COMMAND = 177777 ? COM 1,1 ; YES- MAKE IT 0 MOVZL# 1,1,SZC ; IF THIS IS ERROR ON CHAIN COMMAND JMP EXBAD ; THEN ALL FILES MAY BE CLOSED ! LDA 3,.EREX ; EREXQ "ERROR" CODE SNE 3,2 ; IF USER REQUESTING EXECUTE JMPm PUSHM ; (F)CLI.CM THEN "PUSH" CLI. LDA 3,SAERR ; ILLEGAL START ADDRESS ERROR CODE SEQ 3,2 ; IF NOT ILLEGAL START ADDRESS JMP @.ER1X ; THEN REPORT WHATEVER LDA 2,COMES ; ELSE CLARIFY TYPE OF ERROR. MOVZR 1,1,SZC ; DEBUG ? INC 2,2 ; YES- BUMP ERROR #CODE POINTER LDA 2,0,2 ; GET BAD (START/DEBUG) ERROR CODE JMP @.ER1X ; AND REPORT ERROR. ; HANDLE EXECUTE ERROR ON CHAIN EXBAD: LDA 3,SFNER ; FILE DOES NOT EXIST CODE SNE 3,2 ; IF THIS IS THE PROBLEM JMP @.ER1X ; THEN PROCEED WITH ERROR NORMALLY LDفA 2,MSSAR ; ELSE ALL FILES MAY BE CLOSED JMP @.+1 ; SO RESTART THE CLI AND CLIRS ; AND GIVE GENERALIZED ERROR MESSAGE. ; PROCESS CLI PUSH PUSHM: LDA 3,USP ; RESTORE STACK POINTER LDA 2,SSOSP,3 ; RESTORE OLD STACK POINTER LDA 0,.GTPSH ; AC0 <= PUSH RIETURN ADDRESS STA 0,SSRTN,2 ; SET PUSH RETURN RTRN ; BYE FOR NOW .GTPSH: GTPSH MSSAR: MSADR*2 COMES: .+1 CNSAD CNDBD SFNER: ERDLE SAERR: ERADR SVNP: BKDSV*2 .EREX: EREXQ .ER1X: ER1X ; ; OPEN CONSOLE INPUT DEVICE ; 0 OPENC: LDA 0,.INAME ; $TTO(1a) MOVZL 0,0 ; BYTE POINTER SUB 1,1 S OPEN CIN ; OPEN IT NOP ; IF YOU CAN'T YOU CAN'T RTRN ; THATS ALL .INAME: INAME ; ; CLI COMMAND TABLE ; CMTAB: EXFP*2 ; BEGIN BACKGROUND TABLE @EXFGR FCMTB: NULP*2 ; BEGIN FOREGROUND TABLE @NEXT DEB+DEB c1 @DEBG DTP*2 DOT MKS*2+2 @SAVE CHP+CHP @CHAIN 0 ; OVERLAY #0 POPIT*2 PPOP REV0*2 REVNO CH*2 CHATR CHAP+CHAP CHLAT CRA*2 CRAN CRE+CRE CREA CCO+CCO CCON CPRT+CPRT CPAR APP+APP APPEND RNP+RNP RENAME SPP*2 SPACE SQP+SQP SQUAS IWONTC*2 INITC RLSC*2 RLSEC GDI+GDI+1 DIR SDAYP*2 SDAY NSTOD*2 STOD NGTOD*2 GTOD SEBL+SEBL SPEBL SKIL+SKIL SPKIL SDIS+SDIS SPDIS BTP+BTP BOOT KSP+KSP+3 SPY KSP+KSP KSPY RPL+RPL REPLAC 0 ; OVERLAY #1 CLEP+CLEP CLEAR DUM+DUM DUMP FGTAB: 0 ; #2 - BEGIN EXFG TABLE CLGN*2 EXEC ASMP*2 EXEC MACP*2 EXEC MASMP*2 EXEC 2*ALGP EXEC 2*FORP EXEC 2*FORTP EXEC RLDP*2 EXEC OVLP+OVLP EXEC LFEN*2 EXEC BATP+BATP EXEC 0 ; #3 - END EXFG TABLE LIS+LIS LIST MESG*2 MESSAGE T:qFGND*2 WFGND 0 ; #4 LOD+LOD LOAD 0 ; #5 CKMB*2 CKMAB MKS+MKS MKSAVE ULP+ULP+2 LINK EQP+EQP EQUIV CDI+CDI CDIR GDI+GDI GDIR MDI+MDI MDIR LDR*2 LDIR GS+GS GSYS GMP+GMP GMEM SMP+SMP SMEM XFA+XFA XFER PRINM*2 PRINT BPUN*2+1 PUNCH BPUN*2 BPUNCH TYPEM*2 TYPE FILP+FILP FILCOM 0 ; #6 OVERLAY 6 TUONS*2 TUON TUOFS*2 TUOFF TPRNT*2 TPRINT 0 ; #7 DEL+DEL DELET ULP+ULP UNLINK BUIL+BUIL BUILD 0 ; #10 MOVF*2 MOVEF 0 ; # 11 FPRN*2 FPRIN -1 ENTAB: @ENDLS ; (@FGNDL)- END OF COMMMAND TABLE ; MESSAGES AND OTHER BULKY STUFF ** .NOLOC 1 SQP: .TXT *SQUASH* DEL: .TXT *DELETE* RLDP: .TXT *RLDR* DTP: .TXT *.* SPP: .TXT *DISK* BUIL: .TXT *BUILD* FPRN: .TXT *FPRINT* MKS: .TXT *MKSAVE* ; PTR TO SAVE AND MKSAVE CHP: .TXT *CHAIN* DEB: .TXT *DEB* EXFP: .TXT *EXFG* BATP: .TXT *BATCH* ULP: .TXT *UNLINK* ; PTR TO BOTH UNLINK AND LINK SEBL: .TXT *SPEBL* SKIL: .TXT *SPKILL* SDIS: .TXT *SPDIS* LIS: .TXT *LIST* CRE: .TXT *CREATE* CRA: .TXT *CRAND* MOVF: .TXT *MOVE* CCO: .TXT *CCO|NT* ; PTR TO CCONT AND CONT CDI: .TXT *CDIR* BTP: .TXT *BOOT* KSP: .TXT *ENDLOG* ; PTR TO LOG AND STOPLOG RPL: .TXT *REPLACE* GDI: .TXT *GDIR* MDI: .TXT *MDIR* LDR: .TXT *LDIR* GS: .TXT *GSYS* CPRT: .TXT *CPART* CLEP: .TXT *CLEAR* GMP: .TXT *GMEM* SMP: .TXET *SMEM* XFA: .TXT *XFER* .TXTN 1 BKDSV: .TXT *FBREAK* .TXTN 0 SVEP: .TXT *.SV* MCEP: .TXT *.MC* CLIC: .TXT *FCLI.CM* CH: .TXT *CHATR* CHAP: .TXT *CHLAT* FCOMF: .TXT *FCOM.CM* ASMP: .TXT *ASM* MACP: .TXT *MAC* MASMP: .TXT *MASM* OVLP: .TXT *OVLDR* APP: . FTXT *APPEND* RNP: .TXT *RENAME* EQP: .TXT *EQUIV* FILP: .TXT *FILCOM* LOD: .TXT *LOAD* DUM: .TXT *DUMP* TYPEM: .TXT *TYPE* PRINM: .TXT *PRINT* BPUN: .TXT *BPUNCH* CKMB: .TXT *MKABS* ALGP: .TXT *ALGOL* FORTP: .TXT *FORTRAN* FORP: .TXT *FORT* NULP: 0 MSADR: L.TXT *EXECUTE ERROR ON CHAIN<15>* INTC: .TXT *INIT* RLSC: .TXT *RELEASE* LFEN: .TXT *LFE* CLGN: .TXT *CLG* SDAYP: .TXT *SDAY* NSTOD: .TXT *STOD* NGTOD: .TXT *GTOD* REV0: .TXT *REV* POPIT: .TXT *POP* TUONS: .TXT *TUON* TUOFS: .TXT *TUOFF* TPRNT: .TXT *TPRIN>+T* MESG: .TXT *MESSAGE* TFGND: .TXT *FGND* ** .NOLOC 0 .END GSUBR.SR5 E?Y ; ; GENERAL FUNCTIONS SUBROUTINE PACKAGE ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CGSUBR .RB CGSUBR.RB ** .ENDC J .TITL BGSUBR .RB BGSUBR.RB **[J] .NREL .TXTM 1 ; PA=qCK EM LEFT TO RIGHT .ENT GETAR ; GET NEXT ARGUMENT .ENT GETSW ; GET SWITCHES OF ARGUMENT .ENT GETSP ; GET POINTER TO SWITCHES .ENT SETSW ; SET SWITCH ROUTINE .ENT LDBT ; LOAD BYTE ROUTINE .ENT LDBI ; LOAD BYTE AND INC .ENT STBT ; STORE BYTE ROUTINE .ENT STBI ; STORE BYTE AND INC .ENT MOVE ; MOVE CHARACTER ROUTINE .ENT CMOVE ; MOVE CHARACTER ROUTINE .ENT COMP ; COMPARE STRINGS .ENT INDEX ; FIND A CHARACTER .ENT .INDEX ; FIND A CHARACTER .ENT USTSN ; USER NAME TO SYSTEM NAME .EXTN CALL RTRN ;e LINKING ROUTINES ; ; GETARG- ; ROUTINE TO RETURN A BYTE POINTER TO AN ARGUMENT. ; ON ENTRY- AC0 = BYTE POINTER TO LOCATION IN MEMORY RESIDENT ; BUFFER FROM WHICH TO START SEARCHING. ; ON RETURN- AC0 = BYTE POINTER TO ARG/END OF ARG STRglING ; CALLING SEQUENCE: ; C GETARG ; NO ARGUMENT FOUND RETURN ; ARGUMENT FOUND RETURN ; 0 GETARG: C LDBI ; SCAN TO END OF CURRENT ARGUMENT MOV# 1,1,SZR ; END OF ARGUMENT? JMP GETARG ; NO- KEEP SCANNING LDA 1e,C4 ; YES- BUMP POINTER PAST SWITCHES ADD 1,0 C LDBT ; GET FIRST BYTE OF NEXT ARG LDA 3,C377 ; AC3 <= END OF ARGMENTS STRING INDICATOR COMX: STA 0,SSAC0,2 ; RETURN CURRENT POINTER TO CALLER SUB# 3,1,SNR ; END OF ARGUMENTS? RTRN ; YES- TAKE NOT FOUND RETURN C GETSW ; GET SWITCHES MOVZR 2,2 ; MOVE INVISABLE SWITCH TO CARRY LDA 2,SSOSP,3 ; RESTORE AC2 MOV 0,0,SZC ; ARGUMENT KILLED ?? JMP GETAR ; YES- GET NEXT ARG ISZ SSRTN,2 ; SET ARG FOUND RETURN RTRN C4: 4 ; ; ROUTINES TO GET SWITCHES OR SWjITCH POINTER. ; GETSP RETURNS POINTER TO SWS OF CURRENT ARG IN AC1. ; GETSW RETURNS SWS OF CURRENT ARG IN ACS 1 AND 2. ; 0 GETSP: MOVO 0,0 ; SET CARRY FOR ENTRY POINT FLAG JMP GETS1 ; COMMON CODE 0 GETSW: MOVZ 0,0 ; CLEAR CARRY FOR ENTRY POINT FLAG GETS1: C LDBI ; GET A BYTE MOV# 1,1,SZR ; IS IT NULL ? JMP GETS1 ; NO - GO BACK MOV# 0,0,SNC ; CHECK CARRY JMP GETS2 ; GETSW STA 0,SSAC1,2 ; RETURN POINTER IN AC1 RTRN GETS2: SUBO 2,2 ; CLEAR AC, CARRY LOOP: C LDBI MOVS 1,2 ; LOAD A SW BYTE SAVE IN AC2 C LDBI ; SECOND HALF LDA 3,SSOSP,3 ADD 1,2,SZC ; COMPLETE WORD AND CHECK FOR END JMP LOOP1 ; CARRY FLAG INDICATES END- EXIT STA 2,SSAC1,3 ; RETURN FIRST SWITCH WORD SUBZ 2,2 ; CLEAR AC2 AND FLAG LAST TIME JMP LOOP ; GET NEXT SWITCH WORD LOOP1: {9STA 2,SSAC2,3 ; RETURN SECOND SWITCH WORD RTRN ; ; ROUTINE TO SET A SWITCH ; AC0 -> ARG. ; AC1: N,,M ; 0 SETSW: MOVS 1,2 C GETSP MOV 1,0 LDA 1,C377 AND 2,1 ADD 1,0 C LDBT COM 1,1 LDA 3,C377L ANDS 3,2 COM 2,2 AND 2,1 COM 1,1 C STBT RTRN C377L: 377*400 ; ; LOAD/STORE BYTE ROUTINES ; ; ; ROUTINE TO LOAD A BYTE INTO AC1 ; GIVEN A BYTE POINTER IN AC0 0 LDBI: ISZ SSAC0,2 ; BUMP BYTE POINTER JMP LDBT ; CONTINUE 0 LDBT: MOVZR 0,3 ; MAKE REAL ADDRESS LDA 0,C377 ; MASK LDA 1,0,3 ; BYTE WOyORD MOV# 0,0,SNC ; RIGHT OR LEFT HALF MOVS 1,1 ; LEFT - SWAP AND 0,1 ; MASK OFF STA 1,SSAC1,2 ; PUT IN AC1 RTRN ; ROUTINE TO STORE A BYTE INTO A STRING ; GIVEN A BYTE IN AC1 AND BYTE POINTER IN AC0 0 STBI: ISZ SSAC0,2 ; BUMP BYTE POINTER JMP STBT ; CONTINUE 0 STBT: LDA 2,C377 ; MASK AND 2,1 ; MASK OFF LEFT MOVZR 0,3,SZC ; MAKE REAL ADDRESS AND ADJUST MASK MOVS 2,2 ; SWAP MASK  LDA 0,0,3 ; LOAD BYTE WORD AND 2,0,SNC ; MASK TARGET WORD MOVS 1,1 ; SWAP BYTE ADD 0,1 STA 1,0,3 ; PUT BACK RTR$N C377: 377 ; ; MOVE- ; CHARACTER MOVE ROUTINE. ; ON ENTRY- AC0 => FROM STRING (TERMINATED BY A NULL) ; AC1 => TO STRING ; ON RETURN- AC0 => TERMINATING NULL ; THE TERMINATING NULL IS MOVED. ; FP=1 TP=FP+1 PEND=TP PEND 3MOVE: STA 0,FP,3 ; SAVE FROM POINTER STA 1,TP,3; SAVE TO POINER C LDBT ; AC1 <= NEXT BYTE LDA 0,TP,3 ; AC0 => PLACE TO STORE IT C STBT ; STORE THE BYTE MOV# 1,1,SNR ; WAS IT A NULL? JMP MFIN ; YES- MOVE IS FINISHED ISZ FP,3 ; NO- BUMP FROM POINTER^ ISZ TP,3 ; BUMP TO POINTER LDA 0,FP,3 ; AC0 => NEXT BYTE JMP MOVE+2 ; GO GET IT MFIN: STA 0,SSAC1,2 ; RETURN POINTER TO CALLER RTRN ; ; CMOVE- ; CHARACTER MOVE ROUTINE. ; SAME AS MOVE BUT AC2 = # CHARS TO BE MOVED. ; ON ENTRY- AC0 => FROM STRING ;^ AC1 => TO STRING ; AC2 = NUMBER OF CHARACTERS TO MOVE ; ON RETURN, AC1 => 1 BYTE PAST LAST CHARACTER MOVED ; PEND CMOVE: STA 0,FP,3 ; SAVE FROM POINTER STA 1,TP,3 ; SAVE TO POINTER LDA 2,SSAC2,2 ; AC2 = # CHARS TO BE MOVED NEG 2,2,SNR ; AC2 <= - # CHARS TO BE MOVED JMP MRET ; NONE TO BE MOVED- EXIT MOVZR# 2,2,SZC ; EVEN NUMBER OF BYTES TO MOVE ? JMP MLOOP ; NO- DO BYTE MOVES MOVZR# 0,0,SNC ; EVEN FROM ADDRESS ? MOVZR# 1,1,SZC ; EVEN TO ADDRESS ? JMP MLOOP ; IF EITHER IS NO,L DO BYTE MOVE MOVZR 1,3 ; YES YES MOVE WORDS MOVOR 2,1 MOVZR 0,2 MLOO1: LDA 0,0,2 ; MOVE A WORD LOOP STA 0,0,3 INC 2,2 INC 3,3 INC 1,1,SZR ; DONE ? JMP MLOO1 ; NO MOVE ANOTHER MOVZL 3,0 ; RETURN UPDATED POINTER LDA 3,USP JMP MRET1 MLOOP: C eLDBT ; MOVE BYTES LOOP LDA 0,TP,3 C STBT ISZ FP,3 ISZ TP,3 LDA 0,FP,3 INC 2,2,SZR JMP MLOOP MRET: LDA 0,TP,3 MRET1: LDA 2,SSOSP,3 JMP MFIN ; NOW GO RETURN POINTER AND EXIT ; ; ROUTINE TO COMPARE TWO CHARACTER STRINGS. ; BYTE POINTERS IN AC0 AND AC1. BOTH STRINGS ; ARE TERMINATED BY NULLS. ; ; CALLING SEQUENCE: ; ; C COMP ; MATCH ; NOT MATCH ; P1=1 P2=P1+1 PEND=P2 PEND COMP: STA 0,P1,3 ; SAVE IN THIS FRAME STA 1,P2,3 ; SAVE MOVZ 0,0 ; CLEAR CARRY BACK: LDA 0,P1,3 ; POINTER C LDBT= ; GET A BYTE MOV 1,2,SNR ; LOOK FOR NULL MOVO 0,0 ; NULL - SET CARRY LDA 0,P2,3 ; NEXT POINTER C LDBT ; GET A CHAR MOV# 1,1,SNR ; LOOK FOR NULL JMP NULL MOV# 0,0,SZC ; CARRY SET ? JMP NOMAT ; YES - NO MATCH SUB# 2,1,SZR ; ... JMP NOMAT ; BAT IT ISZ P1,3 ; BUMP POINTERS. ISZ P2,3 JMP BACK NULL: MOV# 0,0,SZC ; CARRY SET ? RTRN ; YES - THEY MATCH NOMAT: LDA 2,SSOSP,3 ; NO MATCH ISZ SSRTN,2 RTRN ; ; SUBROUTINES TO FIND A CHAR IN A STRING. ; ON THE CALL AC0 HAS STRING PTR ; AC1 HAS CHAR TO MATCH ; IF CHAR NOT FOUND TAKE ABNORMAL RETURN EXIT ; SEARCH WILL TERMINATE ON A NULL. ; ; INDEX - - RETURN BYTE POINTER IN AC0 0 INDEX: MOVZ 1,2 ; SAVE CHAR IN AC2 C LDBT ; GET A CHAR SUB# 1,2,SNR ; CHECK CHAR MATCH FIRST (MIGHT BE NULL) JMP IRE.T ; A MATCH - RETURN MOV# 1,1,SNR ; NULL MEANS END OF STRING JMP IRET1 INC 0,0 JMP INDEX+1 ; TRY AGAIN IRET: LDA 2,SSOSP,3 ISZ SSRTN,2 MOV# 0,0,SZC JMP .IRET STA 0,SSAC0,2 RTRN IRET1: LDA 2,SSOSP,3 JMP IRET+2 ; .INDEX - - RETURN BYTE POINTER I}{N AC1 0 .INDEX: MOVO 1,2 JMP INDEX+1 .IRET: STA 0,SSAC1,2 RTRN ; ; ROUTINE TO CONVERT USER FORMAT NAME TO SYSTEM ; FORMAT NAME. ; AC0 -> USER NAME ; AC1 -> SYSTEM NAME (6 WORDS, ADJUSTED) ; NMP=1 ; SAVE AC0 (NAME POINTER) SNPX=2 ; SAVE AC1 (SYSTEM NAME AREA) TMX=3 STSIZ=3 STSIZ USTSN: STA 0,NMP,3 ; SAVE NAME PTR STA 1,SNPX,3 ; SAVE POINTER TO OUTPUT AREA MOVZR 1,2 ; CORE ADDRESS FROM BYTE POINTER SUB 1,1 ; CLEAR AC LDA 3,CM6 ; CLEAR SYSTEM NAME AREA STA 1,0,2 INC 2,2 INCO 3,3,SZR JMP .-3 LDA 1,PER ; LOCATE PERIOD IN NAME C .INDEX MOVO 0,0 ; SET CARRY IF NONE FOUND STA 1,TMX,3 ; PTR TO EXT - SAVE SUBC 0,1,SNC ISZ TMX,3 LDA 2,C12 SUBZ# 2,1,SNC MOV 1,2 LDA 0,NMP,3 LDA 1,SNPX,3 C CMOVE SUBZ 2,2,SKP LOOPX: ISZ TMX,3 LDA 08c,TMX,3 C LDBT MOV# 1,1,SNR JMP .+4 ADDCS 1,2,SNC ; ASSEMBLE EXT JMP LOOPX MOVS 2,2 LDA 3,SNPX,3 ; ADDRESS OF EXT LDA 0,C12 ADDZR 0,3 STA 2,0,3 RTRN PER: ". CM6: -6 C12: 12 BCHAR.SR5  ; ; BCHAR- ; ROUTINES TO MANIPULATE VIRTUAL BUFFERS ; ** .NOCON NO.CON ; DON'T LIST CONDITIONAL CODE ** .NOMAC NO.MAC ; DON'T LIST MACRO EXPANSIONS ** .DO CCOND==1 .TITL CBCHAR .RB CBCHAR.RB ** .ENDC J .TITL BBCHAR .RB BBCHAR.RB **[J] .NREL .TX8TM 1 ; PACK EM LEFT TO RIGHT .ENT PCBUF ; PUT CHARACTER INTO BUFFER .ENT GCBUF ; GET CHARACTER FROM BUFFER ** .DO CCOND==1 .ENT PWBUF ; PUT WORD INTO BUFFER .ENT GWBUF ; GET WORD FROM BUFFER .ENT PUSHB ; PUSH BUFFER STATE .ENT POPB ; POP BUFFER STATE ** .ENDC .ENT BFMVI ; MOVE LINE TO BUFFER .ENT BFMVO ; MOVE LINE FROM BUFFER .ENT CLBUF ; INITIALIZE A BUFFER .EXTN CALL RTRN LDBT STBT .EXTN CMDER ; COMMAND ERROR ROUTINE ADDRESS ; ; PCBUF- ; PUT CHARACTER INTO BUFFER AT FIRST FREE BYTE ; ON ENTRY, AC2 => BUFFER HEADER ; AC1 CONTAINS CHARACTER ; 0 PCBUF: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS LDA 0,BFFFB,2 ; AC0 => FIRST FREE BYTE C GETBL ; GET PHYSICAL ADDRESS ISZ BFFFB,2 ; ADD THIS BYTE STA 0,BFMOD,2 ; SHOW BUFFER MODIFIED C STBT ; STORE IT RTRN ; ; GCBUF- ; GET CHARACTER FROM A BUFFER ; ON ENTRY, AC2 => BUFFER HEADER ; AC0 = LOGICAL BYTE ADDRESS ; ON RETURN, AC1 CONTAINS BYTE ; 0 GCBUF: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS C GETBL ; GET BUFFER LOCATION C LDBT ; LOAD THE BYTE LDA 3,SSOSP,3 STA 1,SSAC1,3 ; RETURN THE BYTE RTRN ; ; CLBUF- ; ROUTINE TO INITIALIZE A BUFFER ; 0 CLBUF: LDA 3,SSAC2,2 ; GET BUFFER HEADER ADDRESS CLER BFRPT BFFFB BFMOD BFFBT RTRN ; THATS IT ** .DO CCOND==1 ; ; PWBUF- ; PUT WORD f(INTO BUFFER AT FIRST FREE BYTE ; ON ENTRY, AC2 => BUFFER HEADER ; AC1 CONTAINS WORD ; 0 PWBUF: LDA 2,SSAC2,2 ; PICK UP BUFFER HEADER ADDRESS MOVS 1,1 ; PUT FIRST BYTE IN RIGHT HALF AC1 C PCBUF ; PUT FIRST BYTE INTO BUFFER MOVS 1,1 ; PUT SECOND BYTE INTO RIGHT HALF AC1 C PCBUF ; PUT SECOND BYTE INTO BUFFER RTRN ; ; GWBUF- ; GET WORD FROM A BUFFER ; ON ENTRY, AC2 => BUFFER HEADER ; AC0 = LOGICAL BYTE ADDRESS OF WORD ; ON RETURN, AC1 CONTAINS WORD ; TEMP= 1 ; TEMP STORAGE TEMP{ GWBUF: LDA 2,SSAC2,2 ; PICK UP BUFFER HEADER ADDRESS C GCBUF ; GET LEFT BYTE FROM BUFFER MOVS 1,1 ; SWAP BYTES STA 1,TEMP,3 ; AND SAVE FOR NOW INC 0,0 ; BUMP LOGICAL BYTE ADDRESS C GCBUF ; GET RIGHT BYTE FROM BUFFER LDA 0,TEMP,3 ; RESTORE SAVED B@YTES ADD 1,0 ; AND SET IN RIGHT BYTE LDA 2,SSOSP,3 ; RESTORE CALLER'S STACK POINTER STA 0,SSAC1,2 ; AND RETURN WORD TO CALLER RTRN ; ; PUSHB- ; PUSH BUFFER STATE ; ON ENTRY, AC2 => BUFFER HEADER ; AC1 = CURRENT POSITION IN BUFFER ; 0 PUSqHB: LDA 2,SSAC2,2 ; AC2 <= BUFFER HEADER ADDRESS C PWBUF ; PUSH CURRENT POSITION LDA 1,BFRPT,2 ; AC1 <= START OF CURRENT FRAME C PWBUF ; PUSH IT LDA 0,BFFFB,2 ; START NEW BUFFER FRAME STA 0,BFRPT,2 ; BY MOVING POINTER TO END RTRN ; ; POPB- ; POP BWlUFFER STATE AND RESTORE ; ON ENTRY, AC2 => BUFFER HEADER ; ON RETURN, AC0 = POSITION IN RESTORED BUFFER FRAME ; 0 POPB: LDA 2,SSAC2,2 ; AC2 <= BUFFER HEADER ADDRESS LDA 0,BFRPT,2 ; AC0 <= START OF CURRENT BUFFER FRAME ADCZL 1,1 ; PUSH POINTER BACK ADD 1,0 ; TWO BYTES AND C GWBUF ; GET START OF PREVIOUS BUFFER FRAME STA 1,BFRPT,2 ; AND RESTORE IT. ADCZL 1,1 ; PUSH POINTER BACK ADD 1,0 ; TWO MORE BYTES AND STA 0,BFFFB,2 ; RESTORE FIRST FREE BYTE. C GWBUF ; NOW RECOVER POSITION IN BUFFER LDA 2,SSOSP,3 ; RESTORE OLD STACK POINTER STA 1,SSAC0,2 ; AND RETURN POINTER TO CALLER. RTRN ** .ENDC ; ; BFMVI- ; MOVE LINE TO BUFFER. ; LINE IS TERMINATED BY A NULL. ; ON ENTRY, AC0 => LINE TO BE MOVED ; IP= 1 ; INPUT POINTER IP BFMVI: STA 0,IP,3 ; SAViE POINTER LDA 2,SSAC2,2 ; GET BUFFER ADDRESS BFMI1: LOADB IP ; GET A BYTE LDA 0,BFFFB,2 C GETBL ; GET BUFFER LOCATION C STBT ; STORE THE BYTE STA 0,BFMOD,2 ; SET MODIFIED MOV 1,1,SNR ; A NULL PERHAPS ?? RTRN ; YES FINISHED ISZ BFFFB,2 ; NO UPDATE FIRST FREE BYTE JMP BFMI1 ; AND PROCESS NEXT ; ; BFMVO- ; MOVE LINE FROM BUFFER. ; OP= IP+1 ; OUTPUT POINTER OP BFMVO: LDA 2,SSAC2,2 ; GET BUFFER ADDRESS STA 0,IP,3 ; SAVE INPUT POINTER STA 1,OP,3 ; SAVE OUTPUT POINTER BFMO1: LDA 0,IP,3 ; GET A P{BYTE ISZ IP,3 ; BUMP POINTER C GETBL ; GET BUFFER LOCATION C LDBT LDA 0,OP,3 ; STORE THE BYTE C STBT ISZ OP,3 ; BUMP OUTPUT POINTER MOV 1,1,SZR ; A NULL ? JMP BFMO1 ; NO CONTINUE LDA 0,IP,3 ; YES RETURN UPDATED BUFFER POINTER JMP GETBR ; ; GWET BUFFER LOCATION- ; PERFORMS LOGICAL TO PHYSICAL BYTE ADDRESS TRANSLATION ; AND BRINGS CORRECT BLOCK INTO MEMORY. ; ON ENTRY- AC2 => BUFFER HEADER ; AC0 <= LOGICAL BYTE ADDRESS ; ON RETURN- AC0 <= PHYSICAL BYTE ADDRESS ; 0 GETBL: STA 0,SSAC0,3 ; j\SAVE BYTE POINTER LDA 2,SSAC2,2 ; GET BUFFER POINTER STA 2,SSAC2,3 ; SAVE FOR LATTER GETB: LDA 2,BFFBT,2 LDA 1,BFSIZ SUBZ 2,0,SZC ; IN THIS PAGE ?? SUBZ# 1,0,SZC JMP GETB0 ; NO GET PROPER PAGE LDA 2,SSAC2,3 ; YES RETURN POINTER LDA 1,BFADR,2 ADD 1Z,0 GETBR: LDA 2,SSOSP,3 STA 0,SSAC0,2 RTRN GETB0: ADD 2,0 ; RESTORE AC0 LDA 2,SSAC2,3 ; AND AC2 LDA 1,BFMOD,2 ; CURRENT BLOCK MODIFIED ?? MOV 1,1,SNR JMP GETB2 ; NO JUST READ IN PROPER BLOCK LDA 1,BFCHN,2 ; YES WRITE IT OUT MOVZL 1,1,SNC ; FIL E OPEN ?? JMP GETB1 MOVZR 1,1 ; NO OPEN IT STA 1,BFCHN,2 LDA 0,BFFIL,2 ; AC0 => FILE NAME S ECLR ; CLEAR IT JUST IN CASE NOP ; SO WHAT S DELE ; DELETE IT JUST IN CASE NOP ; DITTO MOV 1,2 ; AC2 = CHANNEL NUMBER SUB 1,1 ; NORMAL OPEN S CRAN ; CREATE NEW ONE JMP REDER S OPEN CPU ; OPEN IT JMP REDER GETB1: LDA 2,SSAC2,3 ; RESTORE BUFFER POINTER LDA 0,BFADR,2 ; WRITE OUT BLOCK MOVZR 0,0 LDA 1,BFFBT,2 LDA 2,BFCHN,2 MOVZR 1,1 MOVS 1,1 S WRB CPU JMP REDER ; NEVER HAPPEN ! LDA 2,SSAC^2,3 ; RESTORE BUFFER POINTER LDA 0,SSAC0,3 ; AND BYTE POINTER GETB2: LDA 1,BLMSK ; MASK OUT NOISE BITS AND 1,0 STA 0,BFFBT,2 ; SAVE AS FIRST ADDRESS SUB 1,1 ; CLEAR MODIFIED FLAG STA 1,BFMOD,2 MOVS 0,1 ; FORM BLOCK NUMBER MOVZR 1,1 LDA 0,BFADR,42 ; AC0 = ADDRESS MOVZR 0,0 LDA 2,BFCHN,2 ; AC2 = BLOCK COUNT AND CHANNEL NUMBER S RDB CPU ; READ THE BLOCK JMP REDER GETB3: LDA 0,SSAC0,3 ; RESTORE 0 AND TWO LDA 2,SSAC2,3 JMP GETB ; AND TRY AGAIN BLMSK: 177000 REDER: LDA 1,CEOF ; EOF OK SUB# 2,1,SNR ; FOR READ JMP GETB3 LDA 3,SSOSP,3 ; GET FILE NAME LDA 3,SSAC2,3 LDA 0,BFFIL,3 ER1 3 ; REPORT ERROR JMP @.CMDER .CMDER: CMDER BFSIZ: SCDBS*2 CEOF: EREOF